如何复制选择将数据从多个工作表中的行数据复制到主工

Question

我希望将不同工作表中的行数据复制到单个（MAIN）工作表。 请帮助

For Each chkbx In ActiveSheet.CheckBoxes
    If chkbx.Value = 1 Then
        For r = 1 To Rows.Count
            If Cells(r, 1).Top = chkbx.Top Then
                With Worksheets("Main")
                    LRow = .Range("C" & Rows.Count).End(xlUp).Row + 1
                    .Range("C" & LRow & ":J" & LRow) = _
                    Worksheets("2nd-Party").Range("C" & r & ":J" & r).Value
                    Worksheets("2nd-Party").Range("C" & r & ":J" & r).Interior.ColorIndex = 37
                End With
                Exit For
            End If
        Next r
    End If
Next

Answer 1

宏将从第2页循环到第4页。您可以轻松地将其更改为：sheetNr = 2 To 4.

For sheetNr = 2 To 4
    For Each chkbx In ActiveSheet.CheckBoxes
        If chkbx.Value = 1 Then
            For r = 1 To Rows.Count
                If Cells(r, 1).Top = chkbx.Top Then
                    With Worksheets("Main")
                        LRow = .Range("C" & Rows.Count).End(xlUp).Row + 1
                        .Range("C" & LRow & ":J" & LRow) = _
                        Worksheets(sheetNr).Range("C" & r & ":J" & r).Value
                        Worksheets(sheetNr).Range("C" & r & ":J" & r).Interior.ColorIndex = 37
                    End With
                    Exit For
                End If
            Next r
        End If
    Next
Next sheetNr

如果您更喜欢使用工作表的名称，您可以定义包含工作表名称的数组，然后使用for循环获取这些名称

SheetName =数组（“第一方”，“第二方”，“第三方”）

For i = 0 to 2
...
Worksheets(SheetName(i)).Range("C" & r & ":J" & r).Value
...
next i