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
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.
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
Workbooks.Open is a function, that returns a reference to the
Workbook object that was opened – and you’re discarding it.
Dim wb As Workbook
Then assign it to the result of the
Set wb = Workbooks.Open(Filepath & MyFile)
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