在所需位置粘贴多张纸的数据

Question

这是我用来将数据从多张表复制到单张表的代码。 我想知道是否有任何方法可以将数据从第3列开始复制到“报告”表中，即数据应该从第3列开始粘贴到表格中。

Sub AppendDataAfterLastColumn()
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim Last As Variant
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("Report").Delete
On Error GoTo 0
Application.DisplayAlerts = True

' Add a worksheet with the name "Report"
Set DestSh = ActiveWorkbook.Worksheets.Add
DestSh.Name = "Report"

' Loop through all worksheets and copy the data to the
' summary worksheet.
For Each sh In ActiveWorkbook.Worksheets
    If sh.Name <> DestSh.Name Then
  lastcol = DestSh.Cells(1, DestSh.Columns.Count).End(xlToLeft).Column
        ' Find the last column with data on the summary
        ' worksheet.
        Last = lastcol
  lastCol3 = sh.Cells(1, sh.Columns.Count).End(xlToLeft).Column
        ' Fill in the columns that you want to copy.
        Set CopyRng = sh.Range(sh.Cells(1, 2), sh.Cells(15, lastCol3))

        ' 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

评论数据表1：

评论数据表2：

评论的预期结果：