Hi Mag,
Hope this will help you.
RegardsCode:Sub GetSummary() Dim wks As Worksheet For Each wks In ThisWorkbook.Worksheets If wks.Name <> "Summary" Then With wks Intersect(.Range("B5").CurrentRegion, .Range("B5").CurrentRegion.Offset(1)).Copy End With With ThisWorkbook.Worksheets("Summary") .Range("A" & .Range("D" & Rows.Count).End(xlUp).Row + 1).PasteSpecial Application.CutCopyMode = False End With End If Next With ThisWorkbook.Worksheets("Summary") .Range("A1").Value = "Item" .Range("B1").Value = "Qty" .Range("C1").Value = "Rate" .Range("D1").Value = "Total" End With End Sub
Prince




Reply With Quote
Bookmarks