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

Question

我想将行数据从不同的工作表复制到单个（主）工作表。 请帮助

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到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 = Array（“第一方”，“第二方”，“第三方”）

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