使用Excel-VBA将数据从许多工作簿复制到摘要工作簿。 运行时错误

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.