Merging all files in a folder ?

[JumboCactuar]

Hi,
I have several hundred .xlsx files with data I want merged into one file.

* Only .xlsx files
* Sheets("Sheet1")
* Data is in A:F starting at row 2

Best way to approach this? Files are all under 100kb and contain roughly 2000 rows in each

Appreciate any help

 

[davidmg1982]

Good morning @Joe4, this solution fits to what I'm trying to accomplish today, but its there a way to add a column with the name of the workbook is merging for each row of the file?

Thanks ahead for your help.

 

[Joe4]

davidmg1982,

You should be able to do that by adding one line of code:

Sub MyCombineMacro()

    Dim mFile As Workbook
    Dim fName As String
    Dim dPath As String
    Dim dFile As Workbook
    Dim lRowM As Long
    Dim lRowD As Long
    
'   Designate file path of data files
    dPath = "C:\Temp\Files\"
    
'   Make sure a slash appears at the end of dPath
    If Right(dPath, 1) <> "\" Then dPath = dPath + "\"
    
    Application.ScreenUpdating = False
    
'   Open merged file
    Set mFile = Workbooks.Open("C:\Temp\Merged.xlsx")
    
'   Loop through all data files in designated path
    fName = Dir(dPath & "*.xlsx")
    Do While fName <> ""
'       Find last row with data on merged file
        mFile.Activate
        lRowM = Cells(Rows.Count, "A").End(xlUp).Row
'       Open data file
        Set dFile = Workbooks.Open(dPath & fName)
'       Go to Sheet1 and find last row in column A
        Sheets("Sheet1").Activate
        lRowD = Cells(Rows.Count, "A").End(xlUp).Row
'       Copy data from data file to merge file
        Range("A2:F" & lRowD).Copy
        mFile.Activate
        Cells(lRowM + 1, "A").Select
        ActiveSheet.Paste
        Application.CutCopyMode = False
[COLOR=#ff0000]'       Add file name in column G
        Range("G" & lRowM + 1 & ":G" & lRowM + lRowD - 1) = fName[/COLOR]
'       Close data file
        dFile.Close False
'       Move to next file
        fName = Dir
    Loop

'   Save and close
    mFile.Activate
    ActiveWorkbook.Save
    mFile.Close False
    
    Application.ScreenUpdating = True
    
    MsgBox "Merging files complete"

End Sub