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