I have been searching forums and just can't work out the issue with my code. I am very new to macros and I'm sure it's something simple, like some variable not being defined, but I can't figure it out.
I am trying to load data from multiple workbooks into a master and really need help please!
Dir for source files: C:\Test Dir\
Dir for Master: C:\Test Dir\Master\
Source filenames differ, but all end in "*FORMATTED.xlsx."
Master filename: "Payroll Master.xlsx"
Source worksheet name = "Loaded Data"
Master worksheet name = "Summary"
All SOURCE data is in A2:J106.
The top row in the source and Master files are column headers and are identical.
I am loading all data into the Master file "Summary" worksheet.
My latest error is: "Run-time error '1004': Select method of Range class failed." on the "Sheets("Loaded Data").Range("A2:J106").Select" line
This is my current code:
Sub combine_data()
'
Dim MyPath As String
Dim SumPath As String
Dim MyName As String
Dim SumName As String
'Dim MyTemplate As Workbook
'Dim SumTemplate As Workbook
MyPath = "C:\Test Dir\"
SumPath = "C:\Test Dir\Master\"
MyTemplate = "*.xlsx" 'Set the template.
SumTemplate = "Payroll MASTER.xlsx"
MyName = Dir(MyPath & MyTemplate) 'Retrieve the first file
SumName = Dir(SumPath & SumTemplate)
Do While MyName <> ""
Workbooks.Open MyPath & MyName
Sheets("Loaded Data").Range("A2:J106").Select
Selection.Copy
Workbooks.Open SumPath & SumName
Sheets("Summary").Select
Range("A65536").End(xlUp).Offset(1, 0).Activate
Selection.PasteSpecial Paste:=xlPasteValues
Workbooks(MyName).Close SaveChanges:=False 'close
Workbooks(SumName).Close SaveChanges:=True
MyName = Dir 'Get next file
Loop
End Sub
Thank you!
To reduce bugs, you should state Option Explicit at the top of the module. You will then be told when using variables that are not declared and you reduce the risk of misspelling the names of variables.
You should put the SumName = Dir(SumPath & SumTemplate) just before the loop, as the Dir at the end of your Do While ... Loop will refer to the LAST Dir that had parameters. When getting past the error with the Select that you describe, you have ran into this problem.
Inside your loop, you should refer to each workbook/worksheet individually, to clarify what you are doing (helping yourself for the future).
You are opening and closing the MASTER file for every source-file. You could open it before the Loop and close it after. This will make your script faster.
Here is the code modified with the above comments:
Option Explicit
Sub combine_data()
'
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:\Test Dir\"
SumPath = "C:\Test Dir\Master\"
MyTemplate = "*.xlsx" 'Set the template.
SumTemplate = "Payroll MASTER.xlsx"
'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("Summary")
'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("Loaded Data")
'Copy the data from the source and paste at the end of Summary sheet
myWS.Range("A2:J106").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
Related
I have a folder full of multiple excel files and all of the files have a specific sheet that i need to copy into my master.
I need macro to open all files in that folder one by one and copy the specific sheet to the master file using the source file name as sheet name in the master workbook. Excel 2013.
I tried searching online and have the following code:
Option Explicit
Sub test()
Dim wkbDest As Workbook
Dim wksDest As Worksheet
Dim wkbSource As Workbook
Dim wksSource As Worksheet
Dim MyPath As String
Dim MyFile As String
Application.ScreenUpdating = False
Set wkbDest = ThisWorkbook
Set wksDest = wkbDest.Worksheets("Sheet1") 'change the destination sheet name accordingly
MyPath = "H:\Cutover\"
If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
MyFile = Dir(MyPath & "*.xls")
Do While Len(MyFile) > 0
Set wkbSource = Workbooks.Open(MyPath & MyFile)
Set wksSource = wkbSource.Worksheets("Sheet1") 'change the source sheet name accordingly
'Your copy/paste code here (((((need help here please))))))))
wkbSource.Close savechanges:=False
MyFile = Dir
Loop
Application.ScreenUpdating = True
MsgBox "Completed...", vbInformation
End Sub
EDIT:
So i manage to get to the below however its still not working properly. It doesn't rename the sheet to the source filename. Can someone please help?
Option Explicit
Sub test()
Dim wkbDest As Workbook
Dim wksDest As Worksheet
Dim wkbSource As Workbook
Dim wksSource As Worksheet
Dim MyPath As String
Dim MyFile As String
Application.ScreenUpdating = False
Set wkbDest = ThisWorkbook
Set wksDest = wkbDest.Worksheets("Sheet1") 'change the destination sheet name accordingly
MyPath = "H:\Cutover\"
If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
MyFile = Dir(MyPath & "*.xlsx")
Do While Len(MyFile) > 0
Set wkbSource = Workbooks.Open(MyPath & MyFile)
Set wksSource = wkbSource.Worksheets("Sheet1") 'change the source sheet name accordingly
Sheets("SheetToCopy").Copy Before:=Workbooks("WorkbookToPasteIn").Sheets(SheetIndex)
wkbSource.Close savechanges:=False
MyFile = Dir
Loop
Application.ScreenUpdating = True
MsgBox "Completed...", vbInformation
End Sub
so the part you need help with is how to copy/paste a range from a worksheet in one file to a common worksheet in a destination file?
set up a variable to track the last empty row in the destination sheet
look up how to determine what the last row is in each source sheet, select that source range, copy it into the clipboard, and then paste it at the last empty row in the destination sheet, and reset the destination variable to the new first blank row in the destination sheet
an alternative way of doing it would be to open an output CSV file, and parse each row and build up a string and write it to the file without closing the output CSV file until the loop is over
if the files are large tho, it would be much better to use VB.NET instead as it is much faster at dealing with large files
you could also read each file/row into an in-memory datatable and then output the datatable to a CSV file, or to the destination Excel file
which method would you prefer?
You could simply copy your sheet in the new workbook, following this code:
Sheets("SheetToCopy").Copy Before:=Workbooks("WorkbookToPasteIn").Sheets(SheetIndex)
And then, rename the sheet to fit your means.
This is my current code.
Sub Loops()
Dim MyPath As String
Dim MyFileName As String
Dim output As Variant
Dim outputRange(1 To 3) As Range
Set outputRange(1) = Worksheets("vbaTest").Range("output1", Worksheets("vbaTest").Range("output1").End(xlDown))
Set outputRange(2) = Worksheets("vbaTest").Range("output2", Worksheets("vbaTest").Range("output2").End(xlDown))
Set outputRange(3) = Worksheets("vbaTest").Range("output3", Worksheets("vbaTest").Range("output3").End(xlDown))
For Each output In outputRange
'The path and file names:
MyPath = "C:\Users\x\Custom Office Templates"
MyFileName = "Test"
'Makes sure the path name ends with "\":
If Not Right(MyPath, 1) = "\" Then MyPath = MyPath & "\"
'Makes sure the filename ends with ".csv"
If Not Right(MyFileName, 4) = ".txt" Then MyFileName = MyFileName & ".txt"
'Copies the sheet to a new workbook:
Sheets("vbaTest").Range("**output1**").Copy
'The new workbook becomes Activeworkbook:
Workbooks.Add
ActiveSheet.Columns("A").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
With ActiveWorkbook
Application.DisplayAlerts = False
End With
'Brings back original sheet
Workbooks("vbaTest.csv").Activate
'Starts at the top of code
Next output
End Sub
I'm having trouble looping through the different ranges I've set when it comes to output1. "Sheets("vbaTest").Range("output1").Copy"
I'm trying to get vba to loop through the three other outputs that I've set. Any suggestions?
you could shorten down to:
Option Explicit
Sub Loops()
Dim MyPath As String
Dim MyFileName As String
Dim output As Variant
Dim outputRange(1 To 3) As Range
With Worksheets("vbaTest") '<--| reference your worksheet once and for all!
Set outputRange(1) = .Range("output1", .Range("output1").End(xlDown)) '<--| all "dotted" reference implicitly assume the object after preceeding 'With' keyword as the parent one
Set outputRange(2) = .Range("output2", .Range("output2").End(xlDown))
Set outputRange(3) = .Range("output3", .Range("output3").End(xlDown))
End With
For Each output In outputRange
Workbooks.Add.Worksheets(1).Range("A1").Resize(output.Rows.Count).Value = output.Value
Next output
' the following code doesn't currently depend on looping variable
' so I put it outside the loop-> I guess you're setting the new workbooks names
'The path and file names:
MyPath = "C:\Users\x\Custom Office Templates"
MyFileName = "Test"
'Makes sure the path name ends with "\":
If Not Right(MyPath, 1) = "\" Then MyPath = MyPath & "\"
'Makes sure the filename ends with ".csv"
If Not Right(MyFileName, 4) = ".txt" Then MyFileName = MyFileName & ".txt"
End Sub
There are quite a few posts on this site to do with avoiding Select, and if you only need the values then Copy/Paste can be avoided too. It might be worth reading them to assist in the efficiency of your programming.
In terms of your loop, it might be easier to iterate the indexes of your array with a For i = 1 to n style loop. This enables you to reference your objects as a Range rather than the Variant required in the For Each ... style loop.
All together, the loop element of your code could be simplified to:
'Add these declarations
Dim wb As Workbook
Dim i As Long
For i = LBound(outputs) To UBound(outputs)
'...
Set wb = Workbooks.Add
wb.Worksheets(1).Range("A1") _
.Resize(outputs(i).Rows.Count, outputs(i).Columns.Count) _
.Value = outputs(i).Value2
Next
Without any additional changes, you should just change that line to Sheets("vbaTest").Range(output.address).Copy.
However, notice how you use .Copy, then paste special values? Instead, we can set the two ranges equal. Also, you should use workbook/worksheet variables, to keep those straight.
Here's a slightly tweaked code:
Sub Loops()
Dim MyPath As String, MyFileName As String
Dim output As Variant
Dim outputRange(1 To 3) As Range
Dim newWB As Workbook
Dim newWS As Worksheet, mainWS As Worksheet
Set mainWS = Worksheets("vbaTest")
With mainWS
Set outputRange(1) = .Range("output1", .Range("output1").End(xlDown))
Set outputRange(2) = .Range("output2", .Range("output2").End(xlDown))
Set outputRange(3) = .Range("output3", .Range("output3").End(xlDown))
End With
For Each output In outputRange
Debug.Print output.Address
'The path and file names:
MyPath = "C:\Users\x\Custom Office Templates"
MyFileName = "Test"
'Makes sure the path name ends with "\":
If Not Right(MyPath, 1) = "\" Then MyPath = MyPath & "\"
'Makes sure the filename ends with ".csv"
If Not Right(MyFileName, 4) = ".txt" Then MyFileName = MyFileName & ".txt"
'The new workbook becomes Activeworkbook:
Set newWB = Workbooks.Add
Set newWS = newWB.ActiveSheet
'Instead of .Copy/.PasteSpecial Values (meaning, you just want the text), we can
' skip the clipboard completely and just set the two ranges equal to eachother:
' Range([destination]).Value = Range([copy range]).Value
newWS.Columns("A").Value = mainWS.Range(output.Address).Value
With newWB
Application.DisplayAlerts = False
End With
'Brings back original sheet
mainWS.Activate
'Starts at the top of code
Next output
End Sub
The answer I've received from a user above that works the way I want it to is below:
Sheets("vbaTest").Range(output.address).Copy
I have used the following script to copy multiple workbooks (sheets 1 only) into one master workbook. But, as multiple files are saved in the source folder each day, I now have hundreds of files in my source folder and would like to refine the folders that I copy to the master file.
I there a way to restrict the folders by using a date that appears in the file names. File path is ALWAYS the same format ...
5 alpha characters __ the date the file was saved (dateformat: ddmmyy) __ Julian Date
e.g.
NOCSR__060715__162959
SBITT__060715__153902
LVECI__030715__091316
Can I use the date in the file path and allow the user the input 'from' and 'to' dates? The master workbook would then only pull data from files that were saved within the date range.
Sub MergeFilesWithoutSpaces()
Dim path As String, ThisWB As String, lngFilecounter As Long
Dim wbDest As Workbook, shtDest As Worksheet, ws As Worksheet
Dim Filename As String, Wkb As Workbook
Dim CopyRng As Range, Dest As Range
Dim RowofCopySheet As Integer
ThisWB = ActiveWorkbook.Name
path = "K:\UKSW CS Bom Expections\CS_BOM_Corrections\Archive"
RowofCopySheet = 2
Application.EnableEvents = False
Application.ScreenUpdating = False
Set shtDest = ActiveWorkbook.Sheets(1)
Filename = Dir(path & "\*.xls", vbNormal)
If Len(Filename) = 0 Then Exit Sub
Do Until Filename = vbNullString
If Not Filename = ThisWB Then
Set Wkb = Workbooks.Open(Filename:=path & "\" & Filename)
Set CopyRng = Wkb.Sheets(1).Range(Cells(RowofCopySheet, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, Cells(1, Columns.Count).End(xlToLeft).Column))
Set Dest = shtDest.Range("A" & shtDest.Cells(Rows.Count, 1).End(xlUp).Row + 1)
CopyRng.Copy
Dest.PasteSpecial xlPasteFormats
Dest.PasteSpecial xlPasteValuesAndNumberFormats
Application.CutCopyMode = False 'Clear Clipboard
Wkb.Close False
End If
Filename = Dir()
Loop
Thanks, SMORF
Im not sure you need to save the date in the file name. You can read the date created property of a file with this function...
Sub GetDateCreated()
Dim oFS As Object
Dim strFilename As String
'Put your filename here
strFilename = "c:\excel stuff\commandbar info.xls"
'This creates an instance of the MS Scripting Runtime FileSystemObject class
Set oFS = CreateObject("Scripting.FileSystemObject")
MsgBox strFilename & " was created on " & oFS.GetFile(strFilename).DateCreated
Set oFS = Nothing
End Sub
(pinched from here http://www.mrexcel.com/forum/excel-questions/73458-read-external-file-properties-date-created-using-visual-basic-applications.html)
Then you could write a function that takes a start date and end date and returns a list of filenames...
I have few files in a directory or a folder and I want to copy a range (values with format to the current sheet). I have VBA code and I think it is not in order or something is missing in the code. Please help me to fix the issue.
(I have defined named range in each files in the directory. Is it is possible to copy using the named range?)
Copy from directory files given path & from sheet2 & paste it to file "workbook.xlsm" Sheet "sheet1"
Sub LoopThroughDirectory()
Dim MyFile As String
Dim erow
Dim Filepath As String
Filepath = "C:\test"
MyFile = Dir(Filepath)
Do While Len(MyFile) > 0
If MyFile = "workbook.xlsm" Then
Exit Sub
End If
Workbooks.Open (Filepath & MyFile)
Sheets("Sheet2").Select
Range("A1:N24").Copy
Workbooks.Open ("Filepath & workbook.xlsm")
If Sheets("Sheet1").Range("A1") = vbNullString Then
Sheets("Sheet1").Range ("A1:N24")
Selection.PasteSpecial Paste:=xlPasteFormats
Selection.PasteSpecial Paste:=xlPasteValues
Else
Selection.Copy Sheets("sheet1").Cells(A1, Columns.Count).End(xlToLeft).Offset(0, 1)
End If
MyFile = Dir
Loop
End Sub
One question remains:
(I have defined named range in each files in the directory. Is it is possible to copy using the named range?)
It's certainly possible. Thus assuming the Defined Name range is "DATA".
Just replace this line:
sourceWbk.Sheets("Sheet2").Range("A1:N24").Copy
with this:
sourceWbk.Sheets("Sheet2").Range("DATA").Copy
Actually, OP mentioned that this Names are generated by another procedure with the address "A1:N24". So in the case that the address is changed then there will be a need to update every other procedure that refers to it, instead by using the Defined Name don't have to worry about it as it will be taking care by design. That why it’s a good practice to use Defined Names.
I'd use this method:
Sub LoopThroughDirectory()
Dim MyFile As String
Dim FilePath As String
Dim colFiles As Collection
Dim vFile As Variant
Dim wrkbkSource As Workbook
Dim wrkbkTarget As Workbook
Dim rngTarget As Range
FilePath = "C:\test\"
MyFile = "workbook.xlsm"
Set colFiles = New Collection
EnumerateFiles FilePath, "*.xlsm", colFiles
Set wrkbkTarget = Workbooks.Open(FilePath & MyFile)
For Each vFile In colFiles
If vFile <> FilePath & MyFile Then
Set wrkbkSource = Workbooks.Open(vFile, False)
wrkbkSource.Worksheets(1).Range("A1:N24").Copy
Set rngTarget = wrkbkTarget.Worksheets("Sheet1").Cells(1, wrkbkTarget.Worksheets("Sheet1").Columns.Count).End(xlToLeft)
rngTarget.PasteSpecial xlPasteFormats
rngTarget.PasteSpecial xlPasteValues
wrkbkSource.Close False
End If
Next vFile
End Sub
This procedure is needed to get all the files in the folder:
Sub EnumerateFiles(ByVal sDirectory As String, _
ByVal sFileSpec As String, _
ByRef cCollection As Collection)
Dim sTemp As String
sTemp = Dir$(sDirectory & sFileSpec)
Do While Len(sTemp) > 0
cCollection.Add sDirectory & sTemp
sTemp = Dir$
Loop
End Sub
Okay see if it works for you, had to add quite a bit
Sub LoopThroughDirectory()
Dim MyFile As String
Dim erow
Dim Filepath As String
Dim targetWbk As Workbook
Dim sourceWbk As Workbook
Filepath = "C:\test"
MyFile = Dir(Filepath)
Workbooks.Open (Filepath & "\workbook.xlsm")
Set sourceWbk = ActiveWorkbook
Do While Len(MyFile) > 0
If Not MyFile = "workbook.xlsm" And MyFile = "*.xls*" Then
Workbooks.Open (Filepath & MyFile)
Set sourceWbk = ActiveWorkbook
sourceWbk.Sheets("Sheet2").Range("A1:N24").Copy
If targetWbk.Sheets("Sheet1").Range("A1") = vbNullString Then
targetWbk.Sheets("Sheet1").Range("A1:N24").PasteSpecial xlPasteFormulas, xlPasteValues
Else
targetWbk.Sheets("sheet1").Cells(A1, Columns.Count).End(xlToLeft).Offset(0, 1).PasteSpecial xlPasteFormulas, xlPasteValues
End If
MyFile = Dir
End If
Loop
End Sub
I am writing a macro where I take data from a CSV and copy it to another Excel file (not the current or active file).
What is the code to take the copied data and send it to another file in the same directory.
This is my code, I have commented out the lines that cause the macro not to work. I want to set the variable wshT to Sheet1 of the WTF.xlsx file, which is in the same directory but not the active workbook. I have not opened that one. So the goal is to use this macro to copy extra data from the CSV and send it to the WTF.xlsx file and save it as something new, in this case "BBB". Any help is much appreciated. When I uncomment those lines, errors pop up.
Sub Import()
Dim MyPath As String
Dim strFileName As String
'Dim strFileName1 As String
MyPath = ActiveWorkbook.Path
strFileName = MyPath & "\borgwich_die_BM1940_profile.csv"
'strFileName1 = Workbooks("WTF.xlsx").Activate
'strFileName1 = Workbooks("WTF.xlsx").Worksheets("Sheet1").Select
Dim wbkS As Workbook
Dim wshS As Worksheet
Dim wshT As Worksheet
'Set wshT = strFileName1
Set wbkS = Workbooks.Open(Filename:=strFileName)
Set wshS = wbkS.Worksheets(1)
wshS.Range("A1:A3").EntireRow.Delete
'wshS.UsedRange.Copy Destination:=wshT.Range("A1")
wbkS.Close SaveChanges:=False
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=MyPath & "\BBB", FileFormat _
:=51, CreateBackup:=False
Application.DisplayAlerts = False
'ActiveWindow.Close
End Sub
Your use of value assignment to strFileName1 through the use of .Activate and/or .Select was bad methodology. If WTF.xlsx is open, you can directly reference its Sheet1 and Set a worksheet object reference to a variable.
Sub Import()
Dim MyPath As String, strFileName As String
Dim wbkS As Workbook, wshS As Worksheet, wshT As Worksheet
MyPath = ActiveWorkbook.Path
strFileName = MyPath & "\borgwich_die_BM1940_profile.csv"
Set wbkS = Workbooks.Open(Filename:=strFileName)
Set wshS = wbkS.Worksheets(1)
Set wshT = Workbooks("WTF.xlsx").Worksheets("Sheet1")
wshS.Range("A1:A3").EntireRow.Delete
With wshS.Cells(1, 1).CurrentRegion
.Copy Destination:=wshT.Range("A1")
End With
wbkS.Close SaveChanges:=False
Application.DisplayAlerts = False
wshT.Parent.SaveAs Filename:=MyPath & "\BBB", FileFormat:=51, CreateBackup:=False
wshT.Parent.Close SaveChanges:=False
Application.DisplayAlerts = True
End Sub
Another alternative would be to use the VBA equivalent of Data ► Get External Data ► From Text but you should probably know the number and type of fields being brought in with the CSV beforehand. This is certainly the preferred method if the CSV data is being incorrectly interpreted by the temp worksheet you are creating by opening the CSV as a workbook.