Merge Multiple Tabs in Excel Using Fixed Ranges - vba

Question

Apologies in advance as I'm sure this is a simple question, and there's lots of similar answers out there, but I haven't been able to leverage them into a working solution.
My situation is I have an Excel file with 28 tabs. Each Sheet has data in the exact same format in range A1:N10000. Note though that some of the cells in each tab are blank. This holds true across every tab. I would like to have all 28 tabs merged into one new Sheet call Combined.
I have been trying to leverage this Macro:
Sub Combine()
Dim J As Integer
On Error Resume Next
Sheets(1).Select
Worksheets.Add
Sheets(1).Name = "Combined"
Sheets(2).Activate
Range("A1").EntireRow.Select
Selection.Copy Destination:=Sheets(1).Range("A1")
For J = 2 To Sheets.Count
Sheets(J).Activate
Range("A1").Select
Selection.CurrentRegion.Select
Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2)
Next
End Sub
Obviously I've encountered problems running this and the resulting data only has a few values pasted instead of the expected ~280,000 rows (28 tabs, 10k rows each). I suspect one of the reasons is because there are blank cells in the tabs, so this Macro isn't reading the data as I intend it to. How can I modify it just to copy A1:N10000 in each tab and paste each to the Combined tab? Also, will I hit issues with trying to populate a sheet with 280,000 rows?
Thank you!
David

Answer 1

CurrentRegion will not copy everything you want if there are blank cells, as you suspected. Also, it's preferable to avoid using Select - since you don't really need to select the cells before copying - and On Error Resume Next - this doesn't handle errors at all, it ignores them.
Option Explicit
Sub Combine()
Dim i As Integer
Dim combinedWs As Worksheet, ws As Worksheet
Dim copyRng As Range
Dim lastRow As Long
' Add combined worksheet and populate headers
Set combinedWs = Worksheets.Add(Before:=Sheets(1))
combinedWs.Name = "Combined"
Sheets(2).Rows(1).Copy combinedWs.Rows(1)
' Loop through rest of Sheets
For i = 2 To Sheets.Count
Set ws = Sheets(i)
With ws
lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
Set copyRng = Range(.Cells(2, 1), .Cells(lastRow, "N"))
copyRng.Copy combinedWs.Cells(.Rows.Count, 1).End(xlUp).Offset(1)
End With
Next i
End Sub
If you want to copy a specific, hard-coded range, replace the code inside With ws... End With.
Set copyRng = Range(.Cells(2, 1), .Cells(10000, 14))
copyRng.Copy combinedWs.Cells(2, 1).Offset((i-2)*copyRng.Rows.Count)
A bit of a hack on the last line: for each iteration of i you are offsetting by the number of rows in copyRng. You start in combinedWs.Cells(2, 1), or A2. On the first iteration, i - 2 = 0, so there is no offset. On subsequent iterations, you offset 9999, 19998, and so on.

Answer 2

You can try the below code:
Sub Combine()
Dim cmbSheet, ws As Worksheet
Dim tmpIndex As Double
Set cmbSheet = ThisWorkbook.Worksheets.Add
cmbSheet.Name = "Combined"
tmpIndex = 0
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> "Combined" Then
If tmpIndex = 0 Then
cmbSheet.Cells(1, 1) = "Sheet Name"
ws.Range("A1:N1").Copy Destination:=cmbSheet.Cells(1, 2)
End If
ws.Range("A2:N10000").Copy Destination:=cmbSheet.Cells((tmpIndex * 10000) + 2 - tmpIndex, 2)
cmbSheet.Cells((tmpIndex * 10000) + 2, 1).Value = ws.Name
tmpIndex = tmpIndex + 1
End If
Next ws
End Sub