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]

This is the basic structure of one method that would allow you to consolidate data from a group of files. It assumes that the files will be stored in the directory "Documents and Settings" and that they are Excel worksheet files of some type. The procedure would use the Dir function to retrieve the file names one at a time, open the file and copy the data (in this example A20:G20) to the master sheet beginning in Column A. The procedure can be edited for directory, sheet names and range to copy.

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:\Documents and Settings\" 'Edit directory path
fNm = Dir(fPath & ".xl*")
Do
Set wb = Workbooks.Open(fNm)
Set sh2 = wb.Sheets(1)
sh2.Range("A20:G20").Copy sh.Range("A" & lr + 1)
wb.Close False
fNm = Dir
Loop While fNm <> ""
End Sub
Code:

 

[GuyFromStl]

Thank you, I will have to try that.

Is there additional code I can add to determine the size/shape of the data. Example: While the file structure will be the same each file can vary with the number of rows</SPAN>

 

[JLGWhiz]

Thank you, I will have to try that.

Is there additional code I can add to determine the size/shape of the data. Example: While the file structure will be the same each file can vary with the number of rows</SPAN>

Variables for the last column with data and last row with data can be used to define dynamic ranges between sheets, so long as the starting cell remains constant it is pretty easy to do. Assume the starting cell will always be A2:

Add to declarations:

Code:
Dim rng As Range, lstRw As Long
Code:

Insert after The line Set sh2 = wb.Sheets(1):

Code:
lstRw = sh2.Cells(Rows.Count, 1).End(xlUp).Row
Set rng = sh2.Range("A2:A" & lstRw)
rng.EntireRow.copy sh.Range("A" & lr + 1)
Code:

Then delete the line:

sh2.Range("A20:G20").Copy sh.Range("A" & lr + 1)

Now as the code loops through the workbooks, each new sheet will have the range set based on where the last row with data is found. If you have cells in column A with formlas that appear to be blank but in fact contain an empty string (""), they will be detected as cells with data.

 

[GuyFromStl]

Thank you.

I have the code as followed:


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
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


When executing the debug log appears with the following text highlighted
Set wb = Workbooks.Open(fNm)

Did I miss part of the code provided?

 

[JLGWhiz]

Insert the code below after this line fPath = "C:\temp" 'Edit directory path:

Code:
If Right(fPath, 1) <> "\" Then
fPath = fPath & "\"
End If
Code:

The path needs the backslash before the filename or the Dir function fails and then gives you the error message on the Workbooks.Open because wb = Nothing.

 

[GuyFromStl]

That makes sense but I still have the same text highlighted with the updated code.Sub consolidate()Dim sh As Worksheet, lr As Long, fPath As String, wb As Workbook, sh2 As Worksheet, fNm As StringSet sh = Sheets(1) 'Edit name of master sheetlr = sh.Cells(Rows.Count, 1).End(xlUp).Row 'Assumes Col A will be posting referencefPath = "C:\temp" 'Edit directory pathIf Right(fPath, 1) <> "\" ThenfPath = fPath & "\"End IffNm = Dir(fPath & ".xl*")DoSet wb = Workbooks.Open(fNm)Set sh2 = wb.Sheets(1)lstRw = sh2.Cells(Rows.Count, 1).End(xlUp).RowSet rng = sh2.Range("A2:A" & lstRw)rng.EntireRow.Copy sh.Range("A" & lr + 1)wb.Close FalsefNm = DirLoop While fNm <> ""End Sub

 

[JLGWhiz]

That makes sense but I still have the same text highlighted with the updated code.Sub consolidate()Dim sh As Worksheet, lr As Long, fPath As String, wb As Workbook, sh2 As Worksheet, fNm As StringSet sh = Sheets(1) 'Edit name of master sheetlr = sh.Cells(Rows.Count, 1).End(xlUp).Row 'Assumes Col A will be posting referencefPath = "C:\temp" 'Edit directory pathIf Right(fPath, 1) <> "\" ThenfPath = fPath & "\"End IffNm = Dir(fPath & ".xl*")DoSet wb = Workbooks.Open(fNm)Set sh2 = wb.Sheets(1)lstRw = sh2.Cells(Rows.Count, 1).End(xlUp).RowSet rng = sh2.Range("A2:A" & lstRw)rng.EntireRow.Copy sh.Range("A" & lr + 1)wb.Close FalsefNm = DirLoop While fNm <> ""End Sub

I have to assume that the workbooks were loaded into the Temp directory.

 

[JLGWhiz]

That makes sense but I still have the same text highlighted with the updated code.Sub consolidate()Dim sh As Worksheet, lr As Long, fPath As String, wb As Workbook, sh2 As Worksheet, fNm As StringSet sh = Sheets(1) 'Edit name of master sheetlr = sh.Cells(Rows.Count, 1).End(xlUp).Row 'Assumes Col A will be posting referencefPath = "C:\temp" 'Edit directory pathIf Right(fPath, 1) <> "\" ThenfPath = fPath & "\"End IffNm = Dir(fPath & ".xl*")DoSet wb = Workbooks.Open(fNm)Set sh2 = wb.Sheets(1)lstRw = sh2.Cells(Rows.Count, 1).End(xlUp).RowSet rng = sh2.Range("A2:A" & lstRw)rng.EntireRow.Copy sh.Range("A" & lr + 1)wb.Close FalsefNm = DirLoop While fNm <> ""End Sub

I have to assume that the workbooks were loaded into the Temp directory. Thii code below should solve the problem.

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 = ThisWorkbook.Path '"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:

 

[JLGWhiz]

That makes sense but I still have the same text highlighted with the updated code.Sub consolidate()Dim sh As Worksheet, lr As Long, fPath As String, wb As Workbook, sh2 As Worksheet, fNm As StringSet sh = Sheets(1) 'Edit name of master sheetlr = sh.Cells(Rows.Count, 1).End(xlUp).Row 'Assumes Col A will be posting referencefPath = "C:\temp" 'Edit directory pathIf Right(fPath, 1) <> "\" ThenfPath = fPath & "\"End IffNm = Dir(fPath & ".xl*")DoSet wb = Workbooks.Open(fNm)Set sh2 = wb.Sheets(1)lstRw = sh2.Cells(Rows.Count, 1).End(xlUp).RowSet rng = sh2.Range("A2:A" & lstRw)rng.EntireRow.Copy sh.Range("A" & lr + 1)wb.Close FalsefNm = DirLoop While fNm <> ""End Sub

I have to assume that the workbooks were loaded into the Temp directory.