Для повышения опыта. Два макроса.
Скрытый текст |
---|
Код |
---|
Sub jjj()
Application.ScreenUpdating = False
copytosheetname = "Накладная" ' target sheet
Set copytosheetaddr = Sheets(copytosheetname).Range("A2") ' start cell on target sheet
i1 = 2 ' row start on sourse sheet (this sheet)
n = Cells.SpecialCells(xlLastCell).Row ' last used row on this sheet
cnt = 0 ' counter rows with how goods
' clear old data and delete extra lines
If Len(copytosheetaddr.Offset(1).Value) > 0 Then
With Sheets(copytosheetname).Range(copytosheetaddr, copytosheetaddr.End(xlDown)).EntireRow
.ClearContents
.Resize(.Rows.Count - 1).Offset(1).Delete Shift:=xlUp
End With
Else
copytosheetaddr.EntireRow.ClearContents
End If
For i = i1 To n
If Len(Cells(i, 5).Value) > 0 Then
If IsNumeric(Len(Cells(i, 5).Value)) Then
If Cells(i, 5).Value > 0 Then
With copytosheetaddr
If cnt > 0 Then .Offset(cnt).EntireRow.Insert Shift:=xlDown: _
.Offset(cnt + 1).EntireRow.FillDown
.Offset(cnt, 0).Value = cnt + 1 ' counter
.Offset(cnt, 1).Value = Cells(i, 2).Value ' goods
.Offset(cnt, 4).Value = Cells(i, 3).Value ' price
.Offset(cnt, 3).Value = Cells(i, 5).Value ' how
End With
cnt = cnt + 1
End If: End If: End If
Next i
Sheets(copytosheetname).Select
End Sub
Sub jjj2()
Application.ScreenUpdating = False
[E:E].Resize([E:E].Rows.Count - 1).Offset(1).ClearContents
End Sub
|
|
Тестируйте.