下标超出范围 - 无法将打开的工作簿设置为活动工作簿

Question

我正在尝试从 Results 工作表中复制两个单元格 B2 & C2 到文件夹中的每个工作簿上，然后将单元格粘贴到主工作簿中，从单元格 A1, A2, A3 etc 开始

我收到错误 Subscript out of range，它没有突出显示任何具体内容，但我假设这是因为运行宏的工作簿没有 'Results' 工作表。

它正在打开正确的工作簿Workbooks.Open (Filepath & MyFile)，但我似乎无法将新打开的工作簿设置为要从中复制然后关闭的 ActiveWorkbook。

谢谢

    Sub LoopThroughDirectory()

Dim MyFile As String
Dim WorkbookCounter As Long
WorkbookCounter = 1
Dim Filepath As String
Dim wb As Workbook

Filepath = "C:\Test\"

Application.ScreenUpdating = False
MyFile = Dir(Filepath)

'Opens workbooks located C:\Test\ in order
Do While Len(MyFile) > 0
Set wb = Workbooks.Open(Filepath & MyFile)

'Copy cells B2 & C2 from the results worksheet
wb.Worksheets("Results").Range("B2:C2").Copy
Application.DisplayAlerts = False

'Paste cells B2 & C2 to A1
Sheets(WorkbookCounter).Select
ActiveSheet.Paste Destination:=Worksheets(WorkbookCounter).Range("A1")
wb.Close SaveChanges:=False

Application.CutCopyMode = False
WorkbookCounter = WorkbookCounter + 1
If WorkbookCounter > 1000 Then
Exit Sub
End If

MyFile = Dir
Loop
ActiveWorkbook.Save
Application.ScreenUpdating = True

End Sub

Answer 1

Workbooks.Open 是一个函数，它返回对已打开的 Workbook 对象的引用 - 而您正在丢弃它。

声明一个Workbook 变量。

Dim wb As Workbook

然后将其分配给Workbooks.Open 调用的结果：

Set wb = Workbooks.Open(Filepath & MyFile)

现在wb 是您使用的工作簿对象 - 无论它是否处于活动状态，都不再重要了。

wb.Worksheets("Results").Range("B2:C2").Copy

'NOTE: paste to destination BEFORE closing the workbook

wb.Close SaveChanges:=False