Hi John,
This is a quick attempt in the absence of an example of the file.
It assumes you have a "Summary" sheet, and you are copying small amounts of data.
Sub CopyData()
' Macro to copy data from all sheets to Summary Sheet
' and insert Header info from each sheet in the first three columns.
Application.ScreenUpdating = False
Dim wS As Worksheet
Const ColN = "E" 'Last column for data
SumR = 2 'Row to start Summary Data
For Each wS In ThisWorkbook.Worksheets
If wS.Name <> "Summary" Then
Sheets(wS.Name).Select
lR = Cells(Rows.Count, "C").End(xlUp).Row
For r = 10 To lR
If Cells(r, "C") <> "" Then
Range("A" & r & ":" & ColN & r).Copy Sheets("Summary"). _
Range("A" & SumR).Offset(0, 3)
Sheets("Summary").Cells(SumR, 1) = wS.Cells(1, "C")
Sheets("Summary").Cells(SumR, 2) = wS.Cells(2, "C")
Sheets("Summary").Cells(SumR, 3) = wS.Cells(3, "C")
SumR = SumR + 1
End If
Next r
End If
Next
Sheets("Summary").Select
Application.ScreenUpdating = True
End Sub
If the worksheets are large, and/or you find this a little slow, we could speed it up by reading into an array, however, from what I remember from the last time I helped you, your worksheets are not huge, so this quick bit of code should do the trick.
I hope this helps, please let me know!
Regards,
David
- Please click on the *Add Reputation button at the bottom of helpful responses.
Please mark your thread as SOLVED:
- Click Thread Tools above your first post, select "Mark your thread as Solved".
Bookmarks