将多个工作表中的数据合并到Excel中的摘要工作表中

Question

Sub AppendDataAfterLastColumn()
    Dim sh As Worksheet
    Dim DestSh As Worksheet
    Dim Last As Long
    Dim startrow As Long
    Dim lastrow As Long
    Dim lastcol As Long
    Dim CopyRng As Range

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    ' Delete the summary worksheet if it exists.

    Application.DisplayAlerts = False
    On Error Resume Next
    ActiveWorkbook.Worksheets("Summary").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True

    'Add a worksheet with the name "Consolidate"

    Set DestSh = ThisWorkbook.Worksheets.Add
    DestSh.Name = "Consolidate"

     ' Fill in the start row.
    startrow = 2


    ' Loop through all worksheets and copy the data to the summary worksheet.

    For Each sh In ThisWorkbook.Worksheets
        If sh.Name <> DestSh.Name Then

          ' Find the last column with data on the summary
            ' worksheet.
            Last = lastrow(DestSh)


            ' Fill in the columns that you want to copy.
            Set CopyRng = sh.Range("A:A")


              ' Test to see whether there enough rows in the summary
            ' worksheet to copy all the data.
            If Last + CopyRng.Columns.Count > DestSh.Columns.Count Then
                MsgBox "There are not enough columns in " & _
                   "the summary worksheet."
                GoTo ExitTheSub
            End If

' This statement copies values, formats, and the column width.
            CopyRng.Copy
            With DestSh.Cells(1, Last + 1)
                .PasteSpecial 8    ' Column width
                .PasteSpecial xlPasteValues
                .PasteSpecial xlPasteFormats
                Application.CutCopyMode = False
            End With
    End If
    Next

ExitTheSub:

    Application.Goto DestSh.Cells(1)

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub