With Range("A1:E1") .Font.Bold = True .Interior.Color = 12566463 .Cells(1) = "№ п/п" End With
With Range("A1").CurrentRegion .Sort Key1:=.Cells(1, 4), Order1:=xlAscending, Header:=xlYes .Borders.LineStyle = xlContinuous With .Columns(1).Offset(1).Resize(.Rows.Count - 1) .FormulaR1C1 = "=ROW(R[-1]C[-3])" .Value = .Value End With End With
Columns("E:E").Cut Columns("C:C").Insert Shift:=xlToRight For i = Cells(Rows.Count, 5).End(xlUp).Row To 3 Step -1 If Cells(i, 5) <> Cells(i - 1, 5) Then Cells(i, 1).EntireRow.Insert Cells(i, 1).EntireRow.Borders.LineStyle = xlNone i = i - 1 End If Next i Columns.AutoFit
Workbooks("Пример").Sheets(1).Activate Sheets(1).ShowAllData Application.CutCopyMode = False Application.ScreenUpdating = True End Sub
[/vba]
ZatX, привет попробуйте
[vba]
Код
Sub Заказ() Dim i As Long Application.ScreenUpdating = False
With Sheets(1).Range("A1").CurrentRegion .AutoFilter Field:=7, Criteria1:=">0" Union(.Columns(2), .Columns(4), .Columns(5), .Columns(7)).Copy End With
With Range("A1:E1") .Font.Bold = True .Interior.Color = 12566463 .Cells(1) = "№ п/п" End With
With Range("A1").CurrentRegion .Sort Key1:=.Cells(1, 4), Order1:=xlAscending, Header:=xlYes .Borders.LineStyle = xlContinuous With .Columns(1).Offset(1).Resize(.Rows.Count - 1) .FormulaR1C1 = "=ROW(R[-1]C[-3])" .Value = .Value End With End With
Columns("E:E").Cut Columns("C:C").Insert Shift:=xlToRight For i = Cells(Rows.Count, 5).End(xlUp).Row To 3 Step -1 If Cells(i, 5) <> Cells(i - 1, 5) Then Cells(i, 1).EntireRow.Insert Cells(i, 1).EntireRow.Borders.LineStyle = xlNone i = i - 1 End If Next i Columns.AutoFit
Workbooks("Пример").Sheets(1).Activate Sheets(1).ShowAllData Application.CutCopyMode = False Application.ScreenUpdating = True End Sub