Combining Sheets for Greater Than Number not Specific Range or using Sheet Name

[amitaj]

I've see several posts with vba codes to combine all sheets in a workbook into one sheet or select certain sheets based on sheet name or by identifying sheets x to y, but cannot find how to combine sheets from sheet 7 and greater.

I want to combine all sheets in my file to a "Summary" starting with sheet 7 and the number of sheets beyond 7 can vary it could be 4 additional sheets or 20 additional sheets. The sheet names vary each time so I cannot use that.

This is what I have currently which specifies I want to combine data from Sheet7 to Sheet9. If I only have up until sheet 9 in my file and if I try to overachieve in the code to say 7 to 20, the data from sheet 9 will duplicate the additional 11 times which is why this won't work.

Sub Summary()
Dim J As Integer
Dim s As Worksheet

' Add a sheet in first place
On Error Resume Next
Sheets(1).Select
Worksheets.Add
Sheets(1).Name = "Summary"

' Copy headings
Sheets(7).Activate
Range("A1").EntireRow.Select
Selection.Copy Destination:=Sheets(1).Range("A1")

'This is to combine the range of identified worksheets
Dim Cnt
For Cnt = 7 To 9
Application.Goto Worksheets.Item(Cnt).[A1]
Selection.CurrentRegion.Select
' Don't copy the headings
Selection.Offset(2, 0).Resize(Selection.Rows.Count - 1).Select
Selection.Copy Destination:=Sheets("Summary"). _
Cells(Rows.Count, 1).End(xlUp)(2)
Next Cnt
End Sub

Hoping someone can help!

 

[StephenCrump]

If I only have up until sheet 9 in my file and if I try to overachieve in the code to say 7 to 20, the data from sheet 9 will duplicate the additional 11 times which is why this won't work.

Sometimes it's appropriate to use On Error Resume Next where an error may occur but your code expects and allows for this.

The way you are using it is dangerous - your code may error anywhere but will continue, possibly producing incorrect or unintended results. Your code is erroring every time you try to go to a worksheet that doesn't exist, and each time it will copy the last sheet.

Try this:

Sub Summary()
    
    Dim Summary As Worksheet
    Dim i As Long, counter As Long
    Const START_SHEET = 7, HEADER_ROWS = 2
    
    Set Summary = Worksheets.Add(Before:=Worksheets(1))
    Summary.Name = "Summary"
    
    For i = START_SHEET To Worksheets.Count
        With Worksheets(i).Range("A1").CurrentRegion
            If .Rows.Count <= HEADER_ROWS Then
                MsgBox "No data in worksheet " & .Parent.Name, vbOKOnly + vbExclamation
            Else
                .Offset(HEADER_ROWS).Resize(.Rows.Count - HEADER_ROWS).Copy Summary.Cells(counter + 1, 1)
                counter = counter + .Rows.Count - HEADER_ROWS
            End If
        End With
    Next i
        
End Sub