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.
C:\\Users\\ jjordan \\Desktop\\Test Dir\\GA Test\\
C:\\Users\\ jjordan \\Desktop\\Test Dir\\MASTER\\
"*.xlsx."
" MASTER – Data List - 2016.xlsm "
'macro file "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
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.
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.