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
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
Tags: excelexcel