Merge Sheets 1

[buzzt]

I have 30 sheets in a workbook that I would like to combine into 1 sheet (sheet 2 beginning after the last row in sheet 1, and so on...). The layout is exactly the same for each sheet, so if I copy and paste them it works fine, but this is a fairly long process.

How could I do this?

 

[SkipVought]

Hi,

I can suggest to VBA solution...

Sub MergeAllSheets()
'start on the sheet you want to merge everything on
set ws1 = activesheet
with ws1.cells.currentregion
  if .rows.count > 1 then
    rOut = .row + .rows.count
  else
    rOut = 2
  end if
end with
for each ws in worksheets
  if ws.name <> ws1.name then
    ws.cells.currentregion.copy _
      destination:=ws1.cells(rOut, 1)
    with ws1.cells.currentregion
      rOut = .row + .rows.count
    end with
  end if
next
End Sub

Skip,

Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884

 

[KenWright]

I use the following routine to do that, and one of the things it does is to create a new summary sheet with an extra column at the beginning, and for each section of data that gets copied from each sheet, the sheet name will also come with it into this first column. This means that if you dump it all into a Pivot table then you don't lose the granularity that the different sheets represented (If any of course), and can use that field combined with the ShowPages option of you ever need to get back to those separate sheets.

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("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................

----------------------------------------------------------------------------
It's easier to beg forgiveness than ask permission

----------------------------------------------------------------------------