宏粘貼開始第4行而不是1，標題和總計

Question

我有一個很棒的宏，可以創建我的工作表並復制並粘貼以“ A1”開頭的信息，但是我需要它以粘貼新表的“ A4”開頭的信息。 我計划在第1行中添加標題，並在第3行中添加總計。因此，如果您能以正確的方向指出這一點，那也很好。 行的數量將因總數而異。

Sub CopyRangeFromMultiWorksheets()
    Dim sh As Worksheet
    Dim DestSh As Worksheet
    Dim Last As Long
    Dim CopyRng As Range

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


    'Delete the sheet "SUMMARY" if it exist
    Application.DisplayAlerts = False
    On Error Resume Next
    ActiveWorkbook.Worksheets("SUMMARY").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True

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

    'Move the worksheet "SUMMARY"
    Sheets("SUMMARY").Select
    Sheets("SUMMARY").Move Before:=Sheets(7)


    'loop through all worksheets and copy the data to the DestSh
    For Each sh In ActiveWorkbook.Worksheets
        If IsError(Application.Match(sh.Name, _
    Array(DestSh.Name, "EnGarde Data", "Service                                     Data", "Usage", "TECHNICIAN", "MASTER", "Dropdown lists"), 0)) Then


           'Find the last row with data on the DestSh
            Last = LastRow(DestSh)

            'Fill in the range that you want to copy
            Set CopyRng = sh.Range("F2")

            'Test if there enough rows in the DestSh to copy all the data
            If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
               MsgBox "There are not enough rows in the Destsh"
                GoTo ExitTheSub
            End If

            'Copy range to new sheet
            CopyRng.Copy DestSh.cells(Last + 1, "B")

            'Copy the sheet name in the A column
            DestSh.cells(Last + 1, "A").Resize(CopyRng.Rows.Count).Value = sh.Name

            'Fill in the range that you want to copy
            Set CopyRng = sh.Range("B6")

           'Copy range to new sheet
           CopyRng.Copy DestSh.cells(Last + 1, "C")

           'Fill in the range that you want to copy
            Set CopyRng = sh.Range("B4")

           'Copy range to new sheet
           CopyRng.Copy DestSh.cells(Last + 1, "D")

       End If
   Next

ExitTheSub:

Application.GoTo DestSh.cells(1)

'AutoFit the column width in the DestSh sheet
DestSh.Columns.AutoFit

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

Answer 1

當宏完成，並且所有信息都從“ A1”開始粘貼后，您只需在第一行之前插入行即可。 因此，請在ExitTheSub:之后添加此行，並根據需要添加空白行：

DestSh.Rows(1).Insert Shift:=xlDown