我正在尝试从文件夹中每个工作簿上的B2 & C2
工作表中复制两个单元格Results
,然后将单元格粘贴到从单元格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
答案 0 :(得分:2)
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