VBA: how to avoid copying table headers from multiple sheets? - vba

Question

Trying to combine multiple excel sheets is there a way to modify the below so that it does not copy table headers from the other sheets into a sheet called "Combined"?
Sub Combine()
'UpdatebyExtendoffice
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

Answer 1

Quick rewrite and introducing some variables to hold the new sheet and copy range which should help for debugging.
This also incorporates the "skip two header rows" requirement:
Sub Combine()
Dim J As Integer
'Set the newly added sheet to a variable so we can reference.
Dim CombineSheet as Worksheet
Set CombineSheet = Worksheets.Add
CombineSheet.Name = "Combined"
'Assume you are copying the header here. It's a
' little risky hoping that Sheets(2) is going
' to be the one you want.
'Furthermore, getting rid of select/activate
' stuff. Instead directly say which sheet and
' range you want to copy and its destination.
Sheets(2).Range("A1").EntireRow.Copy Destination:=CombineSheet.Range("A1")
'Introducing a new variable to hold the range that will be copied
Dim copyRange as Range
For J = 2 To Sheets.Count
'Cutting out the activates and selects here
Set copyRange = Sheets(J).Range("A1").CurrentRegion
'Offset it and resize skipping 2 header rows and resizing the whole
' range to be 2 rows smaller (the 2 rows we just skipped)
copyRange = copyRange.Offset(2).Resize(copyRange.Rows.Count - 2)
'Copy/Paste
copyRange.Copy Destination:=CombineSheet.Range("A65536").End(xlUp)
Next
End Sub
The biggest change here, besides the removal of the .Select and .Activate is just offsetting by 2 rows and then resizing that range by -2 rows to accommodate that offset.

Answer 2

Try the next updated code, please:
Sub CombineSheets()
Dim J As Long, sh As Worksheet
Worksheets.Add Before:=Sheets(1)
Sheets(1).Name = "Combined"
Sheets(2).Range("A1").EntireRow.Copy Destination:=Sheets(1).Range("A1")
For Each sh In ActiveWorkbook.Sheets
If sh.Name <> Sheets(1).Name Then
sh.Range("A1").CurrentRegion.Offset(2).Resize(sh.Range("A" & sh.rows.Count).End(xlUp).row - 1).Copy _
Destination:=Sheets(1).Range("A" & sh.rows.Count).End(xlUp)(2)
End If
Next
End Sub
Selecting, activating only consume Excel resources and make the code slower...