Macros: Create macro to combine several files

[GuyFromStl]

I receive daily files that I must combine into a single file each month. The data in each file is the same (fields) but the challenge is the file name is different each day.

Is there a way i can create a macro to combine all files together? Since the file names are different I would put into a temp directory and have the macro do a loop until it reads all files.

Any suggestions?

 

[JLGWhiz]

I am having a battle with the IE so the postings are out of whack. But the last code I posted should work. There was an asterisk omitted in the Dir function.

 

[GuyFromStl]

That is correct, the files are in the temp directory. I am not sure where the * will go as I am quite new with using visual basic

 

[JLGWhiz]

That is correct, the files are in the temp directory. I am not sure where the * will go as I am quite new with using visual basic

This code should work:

Code:
Sub consolidate()
Dim sh As Worksheet, lr As Long, fPath As String, wb As Workbook, sh2 As Worksheet, fNm As String
Set sh = Sheets(1) 'Edit name of master sheet
lr = sh.Cells(Rows.Count, 1).End(xlUp).Row 'Assumes Col A will be posting reference
fPath = "C:\temp" 'Edit directory path
If Right(fPath, 1) <> "\" Then
fPath = fPath & "\"
End If
fNm = Dir(fPath & "*.xl*")
Do
Set wb = Workbooks.Open(fNm)
Set sh2 = wb.Sheets(1)
lstRw = sh2.Cells(Rows.Count, 1).End(xlUp).Row
Set rng = sh2.Range("A2:A" & lstRw)
rng.EntireRow.Copy sh.Range("A" & lr + 1)
wb.Close False
fNm = Dir
Loop While fNm <> ""
End Sub
Code:

 

[GuyFromStl]

I apologize but I must be missing something in the code that I copied or the way I am trying to execute the code.</SPAN>

When executing I get a VB error</SPAN>
</SPAN>
Run-time error ‘104’:</SPAN></SPAN>
‘filename.xlsx could not be found. Check the spelling of the file name, and verify that the file location is correct.</SPAN></SPAN>
If you are trying to open the file from your list of most recently used files, make sure that the file has not been renamed, moved, or deleted.</SPAN></SPAN>

When I click on debug button the following text is highlighted </SPAN></SPAN>
Set wb = Workbooks.Open(fNm)</SPAN></SPAN>

 

[JLGWhiz]

I apologize but I must be missing something in the code that I copied or the way I am trying to execute the code.</SPAN>

When executing I get a VB error</SPAN>
</SPAN>
Run-time error ‘104’:</SPAN></SPAN>
‘filename.xlsx could not be found. Check the spelling of the file name, and verify that the file location is correct.</SPAN></SPAN>
If you are trying to open the file from your list of most recently used files, make sure that the file has not been renamed, moved, or deleted.</SPAN></SPAN>

When I click on debug button the following text is highlighted </SPAN></SPAN>
Set wb = Workbooks.Open(fNm)</SPAN></SPAN>

Yes, that one is a mystery because the file should be in the Temp directory. You can step through the code using F8 and wastch the highlight go from line to line. When it passes over the fNm = Dir(fPath & "*.xl*" line, hover the mouse pointer over fNm and it should show a file name in a too-tip pop-up. If the file name is valid then the only thing I can think of is that it is trying to open the file from the current directory. If so then the workbooks open line will need to be modified.

 

[JLGWhiz]

Try replacing the Set wb = Workbooks.Open line with the following:

Code:
Set wb = Workbooks.Open(fPath & fNm)
Code:

 

[GuyFromStl]

That executed the procedure, however, it appears it is overwrites the existing data when it creates a new sheet. I can validate this as if I add up the totals in each spreadsheet it does not match the newly created sheet.

Thank you.

 

[JLGWhiz]

That executed the procedure, however, it appears it is overwrites the existing data when it creates a new sheet. I can validate this as if I add up the totals in each spreadsheet it does not match the newly created sheet.

Thank you.

Yep, needed to move the last row calculation for the destination sheet inside the loop, so it recalcs on each iteration. This is one of the problems with not seeing the products we work with. But this should now do what you need.

Code:
Sub consolidate()
Dim sh As Worksheet, lr As Long, fPath As String, wb As Workbook, sh2 As Worksheet, fNm As String
Set sh = Sheets(1) 'Edit name of master sheet
fPath = "C:\temp" 'Edit directory path
If Right(fPath, 1) <> "\" Then
fPath = fPath & "\"
End If
fNm = Dir(fPath & "*.xl*")
Do
lr = sh.Cells(Rows.Count, 1).End(xlUp).Row 'Assumes Col A will be posting reference
Set wb = Workbooks.Open(fNm)
Set sh2 = wb.Sheets(1)
lstRw = sh2.Cells(Rows.Count, 1).End(xlUp).Row
Set rng = sh2.Range("A2:A" & lstRw)
rng.EntireRow.Copy sh.Range("A" & lr + 1)
wb.Close False
fNm = Dir
Loop While fNm <> ""
End Sub
Code:

 

[GuyFromStl]

Below is a snippet of the file. There will be rouglhy 10 columns of data in each file...As the code still errors out.

Thanks

[TABLE="width: 147"]
<TBODY>[TR]
[TD]Invoice #</SPAN>[/TD]
[TD]Total</SPAN>[/TD]
[TD]Order Number</SPAN>[/TD]
[/TR]
[TR]
[TD="align: right"]114023610</SPAN>[/TD]
[TD="align: right"]100.00 </SPAN>[/TD]
[TD="align: right"]123</SPAN>[/TD]
[/TR]
[TR]
[TD="align: right"]114023610</SPAN>[/TD]
[TD="align: right"]90.00 </SPAN>[/TD]
[TD="align: right"]246</SPAN>[/TD]
[/TR]
[TR]
[TD="align: right"]114023610</SPAN>[/TD]
[TD="align: right"]80.00 </SPAN>[/TD]
[TD="align: right"]369</SPAN>[/TD]
[/TR]
[TR]
[TD="align: right"]114023610</SPAN>[/TD]
[TD="align: right"]70.00 </SPAN>[/TD]
[TD="align: right"]492</SPAN>[/TD]
[/TR]
[TR]
[TD="align: right"]114023610</SPAN>[/TD]
[TD="align: right"]60.00 </SPAN>[/TD]
[TD="align: right"]615</SPAN>[/TD]
[/TR]
[TR]
[TD="align: right"]114023610</SPAN>[/TD]
[TD="align: right"]50.00 </SPAN>[/TD]
[TD="align: right"]738</SPAN>[/TD]
[/TR]
[TR]
[TD="align: right"]114023610</SPAN>[/TD]
[TD="align: right"]40.00 </SPAN>[/TD]
[TD="align: right"]861</SPAN>[/TD]
[/TR]
[TR]
[TD="align: right"]114023610</SPAN>[/TD]
[TD="align: right"]30.00 </SPAN>[/TD]
[TD="align: right"]984</SPAN>[/TD]
[/TR]
[TR]
[TD="align: right"]114023610</SPAN>[/TD]
[TD="align: right"]20.00 </SPAN>[/TD]
[TD="align: right"]1107</SPAN>[/TD]
[/TR]
[TR]
[TD="align: right"]114023610</SPAN>[/TD]
[TD="align: right"]10.00 </SPAN>[/TD]
[TD="align: right"]1230</SPAN>[/TD]
[/TR]
</TBODY><COLGROUP><COL><COL span=2></COLGROUP>[/TABLE]

 

[JLGWhiz]

Guess I am getting tired, I copied the wrong version last time and it didn't have the fPath included in the open statement. Hopefully, this will do it. If not, I will see you tomorrow.

Code:
Sub consolidate()
Dim sh As Worksheet, lr As Long, fPath As String, wb As Workbook, sh2 As Worksheet, fNm As String
Dim lstRw As Long, rng As Range
Set sh = Sheets(1) 'Edit name of master sheet
fPath = "C:\temp" 'Edit directory path
If Right(fPath, 1) <> "\" Then
fPath = fPath & "\"
End If
fNm = Dir(fPath & "*.xl*")
Do
lr = sh.Cells(Rows.Count, 1).End(xlUp).Row 'Assumes Col A will be posting reference
Set wb = Workbooks.Open(fPath & fNm)
Set sh2 = wb.Sheets(1)
lstRw = sh2.Cells(Rows.Count, 1).End(xlUp).Row
Set rng = sh2.Range("A2:A" & lstRw)
rng.EntireRow.Copy sh.Range("A" & lr + 1)
wb.Close False
fNm = Dir
Loop While fNm <> ""
End Sub
Code: