遍历工作簿并将值复制并粘贴到另一个工作簿（VBA、Excel）

Question

我已经花了很长时间试图让这个 sub 工作，但我的 excel 冻结或出现错误。

我通常得到的错误是运行时错误'1004'： 应用程序定义或对象定义的错误 --> 'set rng = ...' 行

我的问题：

我试图让我的 sub 循环遍历一个最好设置为 ActiveWorkbook 的工作簿，而不是设置的工作簿，因为它将位于另一个循环中，该循环将遍历文件夹中的工作簿。然后我希望它遍历工作簿 x 中的行，并从不同的 Cell.Offset(0,x) 显示的不同列中复制某些值。然后，它需要将这些值粘贴到主工作簿中，在子工作簿中表示为 y，在 Range("A" & roww)、Range("B" & roww) 等显示的不同列中。

我的代码在这里：

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

我尝试查看其他问题，但它们似乎不适用于我的问题，我可以设法让它适用于设定值但不适用于变量。

有人能帮我找到问题并更正代码吗？在此先感谢:)

Answer 1

无论何时您声明一个范围，请确保在其中限定所有引用。

你有：

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

看到Range("G2") 和Range("G2").End(xlDown))？那些不符合您想要范围的工作表。正如我评论的那样，只需添加更明确的内容：

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

虽然我承认这有点笨拙，但为什么不添加另一个工作表变量：

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

编辑：我继续更新，清理了一些工作表变量和with 块：

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