Merge multiple files into one excel file with a macro

[katiapro93]

I have worked with Macros, but I am in no way a pro and I need some help getting started. I need to get a bunch of excel workbooks saved in one directory into one workbook. Every day, I will have new reports in a directory that I need to combine into one. Ideally, I would like to clear the one workbook that has the merge data and replace it with a merge of the reports in the directory.

I came across this code, but right off the bat it gives me an error saying it can't find an object. Can some one help me to create a code to clear my master merge workbook and replace it with a new merge of all the data from differed workbooks saved in a directory?

Here is what I have so far.

Sub simpleXlsMerger()
Dim booklist As Workbook
Dim MergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object
Application.ScreenUpdating = False
Set MergeObj = CreateObject("Scripting.FileSystemObject")


'change folder path of excel files here
Set dirObj = MergeObj.getfolder("C:\change\to\excel\files\path\here")


Set filesObj = dirObj.Files
For Each everyObj In fileObj
Set booklist = Workbooks.Open(everyObj)


'change "A2" with cell reference of start point for every file here
'for example "B3:Iv" to merge all files start from column B and Row 3
'If you're files are using more than IV column, change it to the last column
'Also change "A" column on "A65536" to the same column as start point
Range("A2:IV" & Range("A65536").End(x1Up).Row).Copy


ThisWorkbook.Worksheets(1).Activate


'Do not change the following column. It's not the same column as above
Range("A65536").End(x1Up).Offset(1, 0).PasteSpecial


Application.CutCopyMode = False
booklist.Close
Next


End Sub

 

[AlphaFrog]

There is a free Excel add-in that can do this for you...
RDBMerge, Excel Merge Add-in

Here is some code if you're interested.
Merging Data from Multiple Workbooks into a Summary Workbook

 

[JLGWhiz]

Try this VBA version

Sub ximpleXlsMerger2()
Dim wb As Workbook, sh As Worksheet, fPath As String, fName As String
Set sh = ThisWorkbook.Sheets(1)
fPath = ThisWorkbook.Path 'If files are in a different directory than master, replace path here
    If Right(fPath, 1) <> "\" Then fPath = fPath & "\" 'Make sure separator is on end of path
fName = Dir(fPath & "*.xl*") 'get all Excel files in directory
    Do
        If fName <> ThisWorkbook.Name Then
            Set wb = Workbooks.Open(fPath & fName)
            With wb.Sheets(1)
                If Application.CountA(.Rows(2)) > 0 Then
                    .UsedRange.Offset(1).Copy sh.Cells(Rows.Count, 1).End(xlUp)(2)
                End If
            End With
            wb.Close False
        End If
        fName = Dir
    Loop While fName <> ""
End Sub

 

[grhopper]

Try this VBA version

Sub ximpleXlsMerger2()
Dim wb As Workbook, sh As Worksheet, fPath As String, fName As String
Set sh = ThisWorkbook.Sheets(1)
fPath = ThisWorkbook.Path 'If files are in a different directory than master, replace path here
    If Right(fPath, 1) <> "\" Then fPath = fPath & "\" 'Make sure separator is on end of path
fName = Dir(fPath & "*.xl*") 'get all Excel files in directory
    Do
        If fName <> ThisWorkbook.Name Then
            Set wb = Workbooks.Open(fPath & fName)
            With wb.Sheets(1)
                If Application.CountA(.Rows(2)) > 0 Then
                    .UsedRange.Offset(1).Copy sh.Cells(Rows.Count, 1).End(xlUp)(2)
                End If
            End With
            wb.Close False
        End If
        fName = Dir
    Loop While fName <> ""
End Sub

Can this code be modified to include the original file name in column J of each row of data? The formula that I used to produce the file name is:

=Mid(CELL("filename", A1), Search("[", CELL("filename", A1)) + 1, Search(".", CELL("filename", A1)) - 1 - Search("[", CELL("filename", A1)))

 

[JLGWhiz]

See if this will do what you want.

Sub ximpleXlsMerger3()
Dim wb As Workbook, sh As Worksheet, fPath As String, fName As String, r As Range, cnt As Long
Set sh = ThisWorkbook.Sheets(1)
fPath = ThisWorkbook.Path 'If files are in a different directory than master, replace path here
    If Right(fPath, 1) <> "\" Then fPath = fPath & "\" 'Make sure separator is on end of path
fName = Dir(fPath & "*.xl*") 'get all Excel files in directory
    Do
        If fName <> ThisWorkbook.Name Then
            Set wb = Workbooks.Open(fPath & fName)
            With wb.Sheets(1)
                cnt = .UsedRange.Rows.Count - 1
                If Application.CountA(.Rows(2)) > 0 Then
                    Set r = sh.Cells(Rows.Count, 1).End(xlUp)(2)
                    .UsedRange.Offset(1).Copy r
                    r.Offset(, 9).Resize(cnt) = fName
                End If
            End With
            wb.Close False
        End If
        fName = Dir
    Loop While fName <> ""
End Sub

 

[grhopper]

That works almost perfect. What do I need to adjust to leave off the last row of data in each file? That row is a report totals row.

 

[JLGWhiz]

Add the line in red font

Sub ximpleXlsMerger3()
Dim wb As Workbook, sh As Worksheet, fPath As String, fName As String, r As Range, cnt As Long
Set sh = ThisWorkbook.Sheets(1)
fPath = ThisWorkbook.Path 'If files are in a different directory than master, replace path here
    If Right(fPath, 1) <> "\" Then fPath = fPath & "\" 'Make sure separator is on end of path
fName = Dir(fPath & "*.xl*") 'get all Excel files in directory
    Do
        If fName <> ThisWorkbook.Name Then
            Set wb = Workbooks.Open(fPath & fName)
            With wb.Sheets(1)
                cnt = .UsedRange.Rows.Count - 1
                If Application.CountA(.Rows(2)) > 0 Then
                    Set r = sh.Cells(Rows.Count, 1).End(xlUp)(2)
                    .UsedRange.Offset(1).Copy r
                    r.Offset(, 9).Resize(cnt) = fName
                   [COLOR=#b22222] sh.Cells(Rows.Count, "J).End(xlUp).EntireRow.ClearContents[/COLOR]
                End If
            End With
            wb.Close False
        End If
        fName = Dir
    Loop While fName <> ""
End Sub

 

[MaanArpit]

Hello JLG,
kindly help for making a macro which could pick all workbooks data from a folder and paste in selected worksheet one below another.
all have same header.

 

[Geniusweb]

Hello JLG, MaanArpit, all,

do you have an answer already how to merge filed from one folder into one worksheet one below another? Or at least put esch file to another tab of the same worksheet? Thank you.