Try this:-
It will summarise all your sheets into 1, and will insert an Index column at the
start that will tag the source sheet name to each record as well, so you an use
it to filter, or in a Pivot table, or just delete it if you don't want it. Just
tell it what row th headers are in on each sheet (Assumes they all start on the
same row in each sheet)
Sub SummaryCombineMultipleSheets()
Dim SumWks As Worksheet
Dim sd As Worksheet
Dim sht As Long
Dim lrow1 As Long
Dim lrow2 As Long
Dim StRow As Long
HeadRow = InputBox("What row are the Sheet's data headers in?")
DataRow = HeadRow + 1
On Error Resume Next
Application.DisplayAlerts = False
Sheets("Summary Sheet").Delete
Application.DisplayAlerts = False
On Error GoTo 0
Set SumWks = Worksheets.Add
With SumWks
.Move Before:=Sheets(1)
.Name = "Summary Sheet"
Sheets(2).Rows(HeadRow).Copy .Range("1:1")
Columns("A:A").Insert Shift:=xlToRight
Range("B1").Copy Range("A1")
Range("A1").Value = "INDEX"
End With
With Sheets(2)
ColW = .UsedRange.Column - 1 + .UsedRange.Columns.Count
End With
For sht = 2 To ActiveWorkbook.Sheets.Count
Set sd = Sheets(sht)
lrow1 = SumWks.Cells(Rows.Count, "B").End(xlUp).Row
lrow2 = sd.Cells(Rows.Count, "B").End(xlUp).Row
sd.Activate
sd.Range(Cells(DataRow, 1), Cells(lrow2, ColW)).Copy SumWks.Cells(lrow1 + 1,
2)
SumWks.Cells(lrow1 + 1, 1).Resize(lrow2 - (DataRow - 1), 1).Value = sd.Name
Next sht
SumWks.Activate
End Sub
--
Regards
Ken....................... Microsoft MVP - Excel
Sys Spec - Win XP Pro / XL 00/02/03
----------------------------------------------------------------------------
It's easier to beg forgiveness than ask permission
----------------------------------------------------------------------------
Danielle said:
How do I combine identical sheets (identical in the fact that they have the
same titles, row, columns, etc.) but different numbers in each? I have about 12
sheets that need to be combined into one "totals" sheet. I don't want to cut
and paste.
