excel macro test

copy_sheets.vba

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

    On Error Resume Next
    Sheets(1).Select
    Worksheets.Add
    dt = Format(CStr(Now), "yyy_mm_dd_hh_mm")
    nam = "Combined_"
    new_sheet_name = nam & dt
    Sheets(1).Name = new_sheet_name

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

    For Each s In ActiveWorkbook.Sheets
        If s.Name <> new_sheet_name Then
            Application.GoTo Sheets(s.Name).[a1]
            Selection.CurrentRegion.Select
            ' Don't copy the headings
            Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
            Selection.Copy Destination:=Sheets(new_sheet_name). _
              Cells(Rows.Count, 1).End(xlUp)(2)
        End If
    Next
    
    Worksheets(new_sheet_name).Activate
End Sub