合并工作表

Posted 2020-12-31 lizicheng

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