Excel - VBA，将数据行从多个工作表提取到摘要工作表

Question

我是VBA的新手，我想完成我的作业中的几个工作表的摘要数据，所以这是我从几个网站获得的...

Sub AddSummaryData()
    Dim Sh As Worksheet
    Dim Newsh As Worksheet
    Dim myCell As Range
    Dim ColNum As Integer
    Dim Num As Integer
    Dim RwNum As Long
    Dim Basebook As Workbook

    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With

    Set Basebook = ThisWorkbook
    Set Newsh = Basebook.Worksheets("Summary")
    Newsh.Rows("14:27").ClearContents

   'The links to the first sheet will start in row 10
    RwNum = 10

  'Setting the Number
    Num = 0

   For Each Sh In Basebook.Worksheets
       If Sh.Name <> "Main" And Sh.Name <> "Input and Basis" And Sh.Name <> "Template" And Sh.Name <> "Summary" And Sh.Visible Then
            ColNum = 4
            RwNum = RwNum + 4
            Num = Num + 1
            'add number
            Newsh.Cells(RwNum, 1).Value = Num
            'Copy the sheet name in the A column
            Newsh.Cells(RwNum, 2).Value = Sh.Name

            For Each myCell In Sh.Range("A16,B16,F16")  '<--Change the range
            Newsh.Cells(RwNum, 4).Value = Sh.Range("E13")


                ColNum = ColNum + 2
                Newsh.Cells(RwNum, ColNum).Formula = _
                "='" & Sh.Name & "'!" & myCell.Address(False, False)
            Next myCell

            For Each myCell In Sh.Range("A17,B17,F17")  '<--Change the range

                Newsh.Cells(RwNum + 1, ColNum).Formula = _
                "='" & Sh.Name & "'!" & myCell.Address(False, False)
           Next myCell

           For Each myCell In Sh.Range("A18,B18,F18")  '<--Change the range

                Newsh.Cells(RwNum + 2, ColNum).Formula = _
                "='" & Sh.Name & "'!" & myCell.Address(False, False)
           Next myCell

           For Each myCell In Sh.Range("A19,B19,F19")  '<--Change the range

                Newsh.Cells(RwNum + 3, ColNum).Formula = _
                "='" & Sh.Name & "'!" & myCell.Address(False, False)

           Next myCell

        End If
    Next Sh

    'Opening Summary Sheet
    With Sheets("Summary")
        .Select
    End With

    Newsh.UsedRange.Columns.AutoFit

    With Application
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With
 End Sub

我不明白为什么它不起作用，因为我不熟悉VBA，来自 ISO-1L等的数据工作表，不会复制到绿色突出显示的摘要工作表..

图片：

Answer 1

没关系，它已经解决了......

For Each Sh In Basebook.Worksheets
    If Sh.Name <> "Main" And Sh.Name <> "Input and Basis" And Sh.Name <> "Template" And Sh.Name <> "Summary" And Sh.Visible Then
        ColNum = 4
        RwNum = RwNum + 4
        Num = Num + 1
        'add number
         Newsh.Cells(RwNum, 1).Value = Num
        'Copy the sheet name in the column
        Newsh.Cells(RwNum, 2).Value = Sh.Name
        'Copy the Description in the column
        Newsh.Cells(RwNum, 4).Value = Sh.Range("E13")

        For Each myCell In Sh.Range("A16,B16,F16")  '<--Change the range


            ColNum = ColNum + 2
            Newsh.Cells(RwNum, ColNum).Value = myCell.Value
            Newsh.Cells(RwNum + 1, ColNum).Value = myCell.Offset(1, 0).Value
            Newsh.Cells(RwNum + 2, ColNum).Value = myCell.Offset(2, 0).Value
            Newsh.Cells(RwNum + 3, ColNum).Value = myCell.Offset(3, 0).Value
       Next myCell