excel - 尝试将使用复选框选中的行复制到另一个工作簿

Question

我有点卡住了:我有下面的电子表格代码，它将用复选框选中的行复制到第二张工作表中。
我现在需要修改此代码，以便将复制的行粘贴到特定工作表上的另一个工作簿中。
我试过Workbooks("").Worksheets("")并且还使用整个 C 驱动器路径，但总是得到一个运行时 9，下标超出范围错误。我没有任何运气在网上找到解决方案。
为了方便起见，这两个工作簿目前都保存在我的桌面上:

Sub CopyRows()

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("Sheet2")
                    LRow = .Range("A" & Rows.Count).End(xlUp).Row + 1
                    .Range("A" & LRow & ":R" & LRow) = _
                    Worksheets("Sheet1").Range("A" & r & ":R" & r).Value
                End With
                Exit For
            End If
        Next r
    End If
Next

End Sub

这个录制的宏将数据带到它需要去的地方:

Sub Transfer()
'
' Transfer Macro
'

'
    Range("K2").Select
    Selection.Copy
    Windows("Destination.xls").Activate
    Range("E7:E8").Select
    ActiveSheet.Paste
    Windows("WIP - Live.xlsm").Activate
    Range("B2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Destination.xls").Activate
    Range("E9").Select
    ActiveSheet.Paste
    Windows("WIP - Live.xlsm").Activate
    Range("M2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Destination.xls").Activate
    Range("E10").Select
    ActiveSheet.Paste
    Windows("WIP - Live.xlsm").Activate
    Range("G2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Destination.xls").Activate
    Range("E11").Select
    ActiveSheet.Paste
    Windows("WIP - Live.xlsm").Activate
    Range("N2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Destination.xls").Activate
    Range("E12").Select
    ActiveSheet.Paste
    Windows("WIP - Live.xlsm").Activate
    Range("E2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Destination.xls").Activate
    Range("E13").Select
    ActiveSheet.Paste
    Windows("WIP - Live.xlsm").Activate
    Range("A2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Destination.xls").Activate
    Range("E14").Select
    ActiveSheet.Paste
    Windows("WIP - Live.xlsm").Activate
    Range("S2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Destination.xls").Activate
    Range("E15").Select
    ActiveSheet.Paste
    Windows("WIP - Live.xlsm").Activate
    Range("J2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Destination.xls").Activate
    Range("E16").Select
    ActiveSheet.Paste
    Windows("WIP - Live.xlsm").Activate
    Range("I2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Destination.xls").Activate
    Range("E17").Select
    ActiveSheet.Paste
    Windows("WIP - Live.xlsm").Activate
    Range("C2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Destination.xls").Activate
    Range("E20").Select
    ActiveSheet.Paste
    Windows("WIP - Live.xlsm").Activate
    Range("D2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Windows("Destination.xls").Activate
    Range("E21").Select
    ActiveSheet.Paste
    Windows("WIP - Live.xlsm").Activate
End Sub

目标工作簿中出现错误的代码:

Sub CopyRows()

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 Workbooks("Destination").Sheets("Sheet2")
                    LRow = .Range("A" & Rows.Count).End(xlUp).Row + 1
                    .Range("A" & LRow & ":R" & LRow) = _
                    Worksheets("Sheet1").Range("A" & r & ":R" & r).Value
                End With
                Exit For
            End If
        Next r
    End If
Next

End Sub

已解决:我已经设法让它使用以下代码:

Sub CopyRows()

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 Workbooks("Destination.xlsm").Sheets("Details")
                    LRow = .Range("A" & Rows.Count).End(xlUp).Row + 1
                    .Range("A" & LRow & ":U" & LRow) = _
                    Worksheets("Sheet2").Range("A" & r & ":U" & r).Value
                End With
                Exit For
            End If
        Next r
    End If
Next

End Sub

该错误是由目标工作簿中的 Sheet 2 名称引起的。我不得不将名称修改为细节，它开始工作。对于我花了多长时间来说，这简直令人沮丧!
非常感谢 ed2 和 norie 的回复和帮助。非常感谢。

Answer 1

尝试这个:

第一的:
更改

Worksheets("Sheet1").Range("A" & r & ":R" & r).Value

至

Workbooks("WIP - Live.xlsm").Sheets("Sheet1").Range("A" & r & ":R" & r).Value

然后:
更改

With Worksheets("Sheet2")

至

Workbooks("Destination.xls").Sheets("Sheet2")

这假定在运行宏时两个工作簿都已打开。如果没有，您将需要代码来打开其中一个或两个。