Copying data from many workbooks to a summary work

Question

I have files in a folder and I want to copy data from these files and paste them into another Master workbook sheet.

I keep getting a runtime error ‘1004’: Sorry we couldn’t find C:\Users\jjordan\Desktop\Test Dir\MASTER`, It is possible it was moved, renamed or deleted.

The error is highlighted on this line of code: Workbooks.Open SumPath & SumName

I have seen other questions similar to this on the web, I have tried making various changes. But still without success. Please advise.

• Dir for source files: C:\Users\ jjordan \Desktop\Test Dir\GA Test\
• Dir for Master file: C:\Users\ jjordan \Desktop\Test Dir\MASTER\
• Source filenames differ, but all end in "*.xlsx."
• Master filename: " MASTER – Data List - 2016.xlsm " ‘macro file
• Source worksheet name = "Supplier_Comments"

• Master worksheet name = "Sheet5"

  Option Explicit
  
   Sub GetDataFromMaster()
  
        Dim MyPath As String
        Dim SumPath As String
        Dim MyName As String
        Dim SumName As String
        Dim MyTemplate As String
        Dim SumTemplate As String
        Dim myWS As Worksheet
        Dim sumWS As Worksheet
  
       'Define folders and filenames
        MyPath = "C:\Users\jjordan\Desktop\Test Dir\GA Test\"
        SumPath = "C:\Users\jjordan\Desktop\Test Dir\MASTER\"
  
        MyTemplate = "*.xlsx"  'Set the template.
       SumTemplate = "MASTER – Data List - 2016.xlsm"
  
       'Open the template file and get the Worksheet to put the data into
       SumName = Dir(SumPath & SumTemplate)
       Workbooks.Open SumPath & SumName
       Set sumWS = ActiveWorkbook.Worksheets("Sheet5")
  
       'Open each source file, copying the data from each into the template file
       MyName = Dir(MyPath & MyTemplate)    'Retrieve the first file
  
       Do While MyName <> ""
  
      'Open the source file and get the worksheet with the data we want.
       Workbooks.Open MyPath & MyName
       Set myWS = ActiveWorkbook.Worksheets("Suppliers_Comment")
      'Copy the data from the source and paste at the end of sheet 5
       myWS.Range("A2:N100").Copy
       sumWS.Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial         Paste:=xlPasteValues
       'Close the current sourcefile and get the next
       Workbooks(MyName).Close SaveChanges:=False        'close
       MyName = Dir                    'Get next file
       Loop
      'Now all sourcefiles are copied into the Template file. Close and save it
       Workbooks(SumName).Close SaveChanges:=True
  
  End Sub
  

Answer 1

Here is a template for what you'd like done. NOTE that forward slashes can cause run time error b/c vba handles them in an annoying way.

 Sub DougsLoop()
     Dim wbk As Workbook
     Dim Filename As String
     Dim path As String
     Dim rCell As Range
     Dim rRng As Range
     Dim wsO As Worksheet
     Dim StartTime As Double
     Dim SecondsElapsed As Double
     Dim sheet As Worksheet

     Application.ScreenUpdating = False 'these three statements help performance by disabling the self titled in each, remeber to re-enable at end of code
     Application.DisplayAlerts = False
     Application.Calculation = xlCalculationManual

     StartTime = Timer 'Starts timer to see how long code takes to execute. I like having this in macors that loop through files

     path = "C:\Users\jjordan\Desktop\Test Dir\GA Test" & "\" 'pay attention to this line of code********
     Filename = Dir(path & "*.xl??")
     Set wsO = ThisWorkbook.Sheets("Sheet5")

     Do While Len(Filename) > 0 'this tells the code to stop when there are no more files in the destination folder
         DoEvents
         Set wbk = Workbooks.Open(path & Filename, True, True)
             For Each sheet In ActiveWorkbook.Worksheets
                Set rRng = sheet.Range("a2:n100")
                For Each rCell In rRng.Cells
                    wsO.Cells(wsO.Rows.count, 1).End(xlUp).Offset(1, 0).Value = rCell
                Next rCell
             Next
         wbk.Close False
         Filename = Dir
     Loop

     Application.ScreenUpdating = True
     Application.DisplayAlerts = True
     Application.Calculation = xlCalculationAutomatic
     SecondsElapsed = Round(Timer - StartTime, 2)
     MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation
 End Sub

alter to this to your needs and you'll find it works perfectly :)

EDIT: Also in your code you make use of COPY & PASTE a lot. Try avoid doing this in the future. Try doing something:

 ThisWorkbook.Sheets("Sheet1").Range("a1").Value = OtherWork.Sheets("Sheet1").Range("a1").Value

This is more efficient and wont bog down your code as much.

here is some offset logic

 wsO.Cells(wsO.Rows.count, 1).End(xlUp).Offset(1, 0).Value =
 wsO.Cells(wsO.Rows.count, 1).End(xlUp).Offset(0, 1).Value = 
 wsO.Cells(wsO.Rows.count, 1).End(xlUp).Offset(0, 2).Value = 

notice the Offset(x,y) value? Essentially x is down and y is right. this is of course referencing the original position. So to get a value to go in the same row but three columns over you would use "Offset(0,3)" etc etc

Ill let you alter your code to do this. :)

I guess actually trying to piece it together was a struggle? Here this version assumes the macro is in the master workbook(and that youre running it form the master). If you want to change go ahead, but this is as far as I go. At some point, you'll have to experiment on your own.