We help IT Professionals succeed at work.

Merge data from all excel files in a folder to a single file

I have a code which merges all excel files data in a single file. Now i want to add the file name as a column to each row or to a first row in each file's data.

 what should the commands added to to it, please help. More so please help in making the file extension dynamic.

Sub MergeDataFromWorkbooks()
'DECLARE AND SET VARIABLES
Dim wbk As Workbook
Dim wbk1 As Workbook
Set wbk1 = ThisWorkbook
Dim Filename As String
Dim Path As String
Path = "C:\Users\milans\Desktop\Test excel combine work\" 'CHANGE PATH
Filename = Dir(Path & "*.xls")
'--------------------------------------------
'OPEN EXCEL FILES
Do While Len(Filename) > 0 'IF NEXT FILE EXISTS THEN
Set wbk = Workbooks.Open(Path & Filename)
wbk.Activate
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("Book1.xlsm").Activate
Application.ScreenUpdating = False
Dim lr As Double
lr = wbk1.Sheets("sheet1").Cells(Rows.Count, 1).End(xlUp).Row
Sheets("Sheet1").Select
Cells(lr + 1, 1).Select
ActiveSheet.Paste
wbk.Close True
Filename = Dir
Loop
MsgBox "All the files are copied and pasted in Book1."
End Sub
Comment
Watch Question

Try this
Option Explicit

Sub MergeDataFromWorkbooks()
'DECLARE AND SET VARIABLES
Dim wbk As Workbook
Dim wbk1 As Workbook
Dim Filename As String
Dim Path As String
Dim lr As Long
Dim lr2 As Long
Dim col As Integer

Application.ScreenUpdating = False

Set wbk1 = ThisWorkbook
Path = "C:\Users\milans\Desktop\Test excel combine work\" 'CHANGE PATH
Filename = Dir(Path & "*.xls*")
'--------------------------------------------
'OPEN EXCEL FILES
Do While Len(Filename) > 0 'IF NEXT FILE EXISTS THEN
    Set wbk = Workbooks.Open(Path & Filename)
    Range("A1").CurrentRegion.Copy
    wbk1.Activate
    lr = wbk1.Sheets("sheet1").Cells(Rows.Count, 1).End(xlUp).Row
    Sheets("Sheet1").Select
    Cells(lr + 1, 1).Select
    ActiveSheet.Paste
    lr2 = wbk1.Sheets("sheet1").Cells(Rows.Count, 1).End(xlUp).Row
    col = Range("A1").CurrentRegion.Columns.Count
    Range(Cells(lr, col), Cells(lr2, col)) = Filename
    wbk.Close False
    Filename = Dir
Loop
MsgBox "All the files are copied and pasted in Book1."
End Sub

Open in new window

I have made an error in row 30
Range(Cells(lr, col), Cells(lr2, col)) = Filename
It should be
Range(Cells(lr+1, col), Cells(lr2, col)) = Filename

Author

Commented:
This sounds interesting, thanks for the help.

Is there a way the user can get a dialogue box to paste the source path i.e. line 16 of your code is hardcoded? so that user can give the path of his/her choice?

Author

Commented:
It is giving me pop up each time for storing the data in the clipboard, is there a way around so it doesn't ask?
Try attached.
Selection of folder added.
Clipboard warning disabled.

I have moved the filename to column A, in case the files have different number of columns.
The data will be copied to the first empty row in column B.
Merge-data.xlsm
TracyVBA Developer

Commented:
No comment has been added to this question in more than 21 days, so it is now classified as abandoned.

I have recommended this question be closed as follows:

Accept: Ejgil Hedegaard (https:#a42378558)

If you feel this question should be closed differently, post an objection and the moderators will review all objections and close it as they feel fit. If no one objects, this question will be closed automatically the way described above.

broomee9
Experts-Exchange Cleanup Volunteer