问题
I'm trying to copy two cells B2 & C2 from the Results worksheet on every single workbook within a folder and then paste cells in a Master workbook starting in cell A1, A2, A3 etc
I'm getting the error Subscript out of range it isn't highlighting anything specific but I'm assuming it's because the workbook the macro is running from doesn't have a 'Results' sheet.
It's opening the correct workbook Workbooks.Open (Filepath & MyFile) but I don't seem to be able to set the newly opened workbook as the ActiveWorkbook to copy from and then close.
Thanks
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
回答1:
Workbooks.Open is a function, that returns a reference to the Workbook object that was opened - and you're discarding it.
Declare a Workbook variable.
Dim wb As Workbook
Then assign it to the result of the Workbooks.Open call:
Set wb = Workbooks.Open(Filepath & MyFile)
Now wb is the workbook object you work with - whether it's active or not, doesn't matter anymore.
wb.Worksheets("Results").Range("B2:C2").Copy
'NOTE: paste to destination BEFORE closing the workbook
wb.Close SaveChanges:=False
来源:https://stackoverflow.com/questions/52321439/subscript-out-of-range-unable-to-set-open-workbook-as-active-workbook