Loop through a workbook and copy & paste values in to another workbook (VBA, Excel)

Question

I've been spending quite some time trying to get this sub to work but either my excel freezes or I get an error.

The error I usually get is Run-time error '1004': Application-defined or object-defined error --> on the 'set rng = ...' line

My problem:

I'm trying to get my sub to loop through a workbook that is preferably set as the ActiveWorkbook, instead of a set workbook, as it will be inside another loop that will loop through workbooks in a folder. I then want it to loop through the rows in workbook x and copy certain values from different columns shown by the different Cell.Offset(0,x). It then would need to paste these values to a master workbook denoted as y in the sub, in different columns shown by Range("A" & roww), Range("B" & roww), etc.

My code is here:

Sub transferingDataToMaster()

Dim x As Workbook, y As Workbook, rng As Range, Cell As Variant, roww As Long

'## Open both workbooks first:
Set x = Workbooks.Open("/Users/esrom/Desktop/P4H/Test/Jan_19_2.xlsm")
Set y = Workbooks.Open("/Users/esrom/Desktop/P4H/Test/Master_Test.xlsm")
Set rng = x.Sheets("Sheet1").Range(Range("G2"), Range("G2").End(xlDown))

For Each Cell In rng.Cells
    roww = Cell.Row + 2
'Now, transfer values from x to y:
    y.Sheets("Sheet1").Range("A" & roww).Value = Cell.Value
    y.Sheets("Sheet1").Range("B" & roww).Value = Cell.Offset(0, 6).Value
    y.Sheets("Sheet1").Range("C" & roww).Value = Cell.Offset(0, 7).Value
    y.Sheets("Sheet1").Range("D" & roww).Value = Cell.Offset(0, 8).Value
    y.Sheets("Sheet1").Range("E" & roww).Value = Cell.Offset(0, 10).Value
    y.Sheets("Sheet1").Range("F" & roww).Value = Cell.Offset(0, 11).Value
Next

End Sub

I've tried looking at other questions but they don't seem to be applicable to mine and I can manage to get it to work for set values but not variables.

Would anyone be able to help me find the issue and correct the code please? Thanks in advance :)

You should check to make sure the x and y workbooks you've opened are actually open. So the test If x Is Nothing Then Exit Sub will work, or perform your own handling of that condition. — PeterT
Also, to be sure, qualify ranges within ranges: Set rng = x.Sheets("Sheet1").Range(x.Sheets("Sheet1").Range("G2"), x.Sheets("Sheet1").Range("G2").End(xlDown)) — BruceWayne
@PeterT they've both been open when I've been running the sub — Esrom Tecle

BruceWayne BruceWayne · Accepted Answer · 2021-09-22T15:35:08

Whenever you declare a range, make sure to qualify ALL references in there.

You have:

Set rng = x.Sheets("Sheet1").Range(Range("G2"), Range("G2").End(xlDown))

See the Range("G2") and Range("G2").End(xlDown))? Those are not qualified with what sheet you want the ranges on. As I commented, just add that to be more explicit:

Set rng = x.Sheets("Sheet1").Range(x.Sheets("Sheet1").Range("G2"), x.Sheets("Sheet1").Range("G2").End(xlDown))

Though I admit that's a little clunky, so why not add another sheet variable:

  Dim xSheet1 as Worksheet
  Set xSheet1 = x.Sheets("Sheet1")
  Set rng = xSheet1.Range(xSheet1.Range("G2"), xSheet1.Range("G2").End(xlDown))

Edit: I went ahead and updated, cleaning up a little with some worksheet variables, and a with block:

Sub transferingDataToMaster()

Dim janWB As Workbook, masterWB As Workbook
Dim rng As Range
Dim Cell As Variant
Dim iRow As Long ' changed so `iRow` isn't confused as a typo

'## Open both workbooks first:
Set janWB = Workbooks.Open("/Users/esrom/Desktop/P4H/Test/Jan_19_2.xlsm")
Set masterWB = Workbooks.Open("/Users/esrom/Desktop/P4H/Test/Master_Test.xlsm")

Dim janWS As Worksheet, masterWS As Worksheet
Set masterWS = masterWB.Sheets("Sheet1")
Set janWS = janWB.Sheets("Sheet1")
Set rng = janWS.Range(janWS.Range("G2"), janWS.Range("G2").End(xlDown))

For Each Cell In rng.Cells
    ' DO YOU WANT TO START WITH +2? Make sure you don't
    ' mean to put the +2 AFTER the COPY
    iRow = Cell.Row + 2
    'Now, COPY values from Master WB to JAN_19_2:
    With masterWS
        .Range("A" & iRow).Value = Cell.Value
        .Range("B" & iRow).Value = Cell.Offset(0, 6).Value
        .Range("C" & iRow).Value = Cell.Offset(0, 7).Value
        .Range("D" & iRow).Value = Cell.Offset(0, 8).Value
        .Range("E" & iRow).Value = Cell.Offset(0, 10).Value
        .Range("F" & iRow).Value = Cell.Offset(0, 11).Value
    End With
Next

' Change this as needed. THIS WILL SAVE THE JANUARY WORKBOOK
' But not the MASTER

janWB.Close savechanges:=True
masterwb.Close savechanges:=False

End Sub

Loop through a workbook and copy & paste values in to another workbook (VBA, Excel)

1 Answers