Grabbing data from multiple excel files and copy them in a summary sheet

Question

Whenever I run this code I get: Run-time error '9' Subscript out of range. Can't figure out how to fix this error, please help. The code runs trough excel files in a selected folder and copy pastes the selected row. In the next step I would like to extend the code, to store and sum each cell value like this: var1 = var1 + range("A5").value But first please help me how to fix this error. Thank you.

Sub LoopAllExcelFilesInFolder()

Dim OutputWs As Worksheet
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog
Dim Lastrow As Long

'Optimize Macro Speed
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual

'Retrieve Target Folder Path From User
  Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

    With FldrPicker
      .Title = "Select A Target Folder"
      .AllowMultiSelect = False
        If .Show <> -1 Then GoTo NextCode
        myPath = .SelectedItems(1) & "\"
    End With

'In Case of Cancel
NextCode:
  myPath = myPath
  If myPath = "" Then GoTo ResetSettings

'Target File Extension
  myExtension = "*.xlsx"

'Target Path with Ending Extention
  myFile = Dir(myPath & myExtension)

'set output worksheet
  OutputWs = ThisWorkbook.Worksheets(Test)

'Loop through each Excel file in folder
  Do While myFile <> ""

    Workbooks.Open (myPath & myFile)
    Range("A1:D3").Copy
    ActiveWorkbook.Close


    Lastrow = OutputWs.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    ActiveSheet.Paste Destination:=Worksheets("Test").Range(Cells(Lastrow, 1), Cells(Lastrow, 4))

    'Get next file name
      myFile = Dir()
  Loop

'Message Box when tasks are completed
  MsgBox "Task Complete!"

ResetSettings:
  'Reset Macro Optimization Settings
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

End Sub

Answer 1

To set an object reference to your worksheet, you need the keyword Set included:

Set OutputWs = ThisWorkbook.Worksheets("yoursheetname")

The get next file name should also be myFile = Dir and not include the parenthesis.

I took a closer look at the code and it appears that you're not explicitly defining which books are which in each case, meaning that the "orphaned" range statements can cause you problems. The 1004 error though is coming from your Paste statement, which I have corrected for you in the following code:

Sub LoopAllExcelFilesInFolder()

Dim OutputWs As Worksheet
Dim oNewBook As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog
Dim Lastrow As Long

'Optimize Macro Speed
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual

'Retrieve Target Folder Path From User
  Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

    With FldrPicker
      .Title = "Select A Target Folder"
      .AllowMultiSelect = False
      If .Show <> -1 Then GoTo NextCode
      myPath = .SelectedItems(1) & "\"
    End With

'In Case of Cancel
NextCode:
  myPath = myPath
  If myPath = "" Then GoTo ResetSettings

'Target File Extension
  myExtension = "*.xlsx"

'Target Path with Ending Extention
  myFile = Dir(myPath & myExtension)

'set output worksheet
 Set OutputWs = ThisWorkbook.Worksheets("Test")

'Loop through each Excel file in folder
  Do While myFile <> ""

    Set oNewBook = Workbooks.Open(myPath & myFile)
    oNewBook.Worksheets(1).Range("A1:D3").Copy
    oNewBook.Close


    Lastrow = OutputWs.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
    With OutputWs
        Lastrow = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Row
        OutputWs.Paste .Range("A" & Lastrow & ":" & "D" & Lastrow)
    End With

    'Get next file name
      myFile = Dir
  Loop

'Message Box when tasks are completed
  MsgBox "Task Complete!"

ResetSettings:
  'Reset Macro Optimization Settings
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

End Sub

Note that this code assumes that you want to copy from the first worksheet of the opened workbook (hence the oNewBook.Worksheets(1) added to the Range.Copy statement)