2

I am a bit stuck: I have the below code for a spreadsheet which copies rows, selected with a checkbox, into a second sheet.

I now need to amend this code so that the copied rows are pasted into another workbook on a specific sheet.

I have tried Workbooks("").Worksheets("") and also using the whole C drive path but always get a run-time 9, subscript out of range error. I haven't had any luck in finding a solution online.

Both workbooks are saved on my desktop currently for ease:

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

This recorded macro takes the data to where it needs to go:

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

Code with error at destination workbook:

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

Solved: I have managed to get it working with the below code:

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

The error was being caused by the Sheet 2 name in the destination workbook. I had to amend the name to details and it started working. Frustratingly simple for how long I spent on it!

Many Thanks to ed2 and norie for the replies and help. It is much appreciated.

Worldbound
  • 21
  • 4
  • Have you checked out https://stackoverflow.com/questions/40090746/excel-vba-copy-data-from-one-workbook-to-another-workbook?rq=1 – ed2 Aug 04 '21 at 11:25
  • Thank you for the reply! Yeh that syntax for locating the destination workbook is giving me the error. I could record the macro in the same way but then I lose the ability to select which row I want to copy with the checkboxes. – Worldbound Aug 04 '21 at 11:50
  • Record it anyway, post the code it records, and let's have a look. – ed2 Aug 04 '21 at 11:53
  • @ed2 Updated with recorded macro. – Worldbound Aug 04 '21 at 12:16
  • @Worldbound Can you post the amended code that's causing the error(s)? – norie Aug 04 '21 at 12:19
  • Have you tried adding the appropriate file extension for the destination workbook? P.S. Don't post code in a comment - edit the original question and add it there. – norie Aug 04 '21 at 12:54
  • @norie Ah ok, thanks for the heads up. I have saved the document as macro enabled and amended the extension in the code accordingly but there was no change. – Worldbound Aug 04 '21 at 13:04

1 Answers1

0

Try this:

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

to

Workbooks("WIP - Live.xlsm").Sheets("Sheet1").Range("A" & r & ":R" & r).Value
  1. Then: Change
With Worksheets("Sheet2")

to

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

This assumes that both workbooks are already open when the macro is run. If not, you will need code to open one or both of them.

ed2
  • 1,457
  • 1
  • 9
  • 26
  • Gave it a go, no luck. I am getting the error on the `With Workbooks("Destination.xls").Sheets("Sheet2")` line. – Worldbound Aug 04 '21 at 12:40