Hi 11obornys
This Code in the attached appears to do as you describe
'Adapted From
'http://www.excelforum.com/excel-programming/825786-need-macro-to-add-row-at-end-of-groups-to-add-certain-columns.html
Option Explicit
Sub Add_Stuff()
Dim lLoop As Long, LR As Long
Dim rFoundCell As Range
Dim myRegion As String, myStart As String, myEnd As String, myStartRow As String, myEndRow As String
LR = Cells.Find("*", Cells(Rows.Count, Columns.Count), SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
Application.ScreenUpdating = False
Range("A1").EntireRow.Insert
LR = Cells.Find("*", Cells(Rows.Count, Columns.Count), SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row + 1
With Columns(1)
Set rFoundCell = .Cells(1, 1)
For lLoop = 1 To WorksheetFunction.CountIf(.Cells, "Qty")
Set rFoundCell = .Find(What:="Qty", After:=rFoundCell, _
LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
If Not rFoundCell.Offset(0, 1).Value = "Order Summary" Then
myRegion = rFoundCell.CurrentRegion.Address(True, True)
myStart = Split(myRegion, ":")(0)
myEnd = Split(myRegion, ":")(1)
myStartRow = Split(myStart, "$")(2)
myEndRow = Split(myEnd, "$")(2)
Range(Cells(Val(myStartRow) + 1, 1), Cells(Val(myEndRow), 4)).Copy
Cells(LR, 1).PasteSpecial
LR = Cells.Find("*", Cells(Rows.Count, Columns.Count), SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row + 1
End If
Next lLoop
End With
Range("A1").EntireRow.Delete
Application.ScreenUpdating = True
End Sub
Bookmarks