Sub 追加1()
On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim a As Variant
    Sheets("匯總").Delete
    Worksheets.Add before:=Worksheets(1)
    ActiveSheet.Name = "匯總"
    a = Application.InputBox(prompt:="請輸入從第幾個表開始合並", Title:="提示", Default:=2, Type:=1)
        
 
For c = a To Sheets.Count
            Sheets(c).Activate
            Sheets(c).Cells(1, 1).Select
            ActiveCell.CurrentRegion.Select
            Selection.Copy
            Worksheets("匯總").Select
            ActiveSheet.[A65536].End(xlUp).Offset(1, 0).Select
            ActiveSheet.Paste
        
 
Next c
        ActiveSheet.Range("a1").Select
        Selection.EntireRow.Delete
        ActiveSheet.Range("a1").Select
End Sub

合並工作表