excel – Subscript out of range — Unable to set open workbook as active workbook

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

Dim wb As Workbook

Set wb = Workbooks.Open(Filepath & MyFile)

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

'NOTE: paste to destination BEFORE closing the workbook

wb.Close SaveChanges:=False

Tags: excelexcel