PDA

View Full Version : [SOLVED] Merge multiple Excel files into ONE WORKSHEET



nimesh29
02-17-2020, 03:01 PM
Hi All:
I have multiple Excel files that has the same number of columns (with single line of data), I want to combine all those files into single "master" spreadsheet in NEW workbook. Software I am using only sends out single line data per file instead of combing everything into one file.

I tried the several VBA code but, it only seems to create new spreadsheet (tabs) in the Workbook, instead of bringing all the data into single spreadsheet.
I could take all those tabs and combine to create master list but, I don't need all those spreadsheet. Is there a better way to combine all files into single spread sheet?

thanks for your help.

Nimesh

p45cal
02-18-2020, 10:34 AM
Post the code you've tried; it may only need tweaking.

nimesh29
02-18-2020, 11:28 AM
I should have posted the code with my question:
When I run the code, it will ask for data file location and then it copies data from all selected files into the master file.



Sub mergeFiles() 'Merges all files in a folder to a main file.

'Define variables:
Dim numberOfFilesChosen, i As Integer
Dim tempFileDialog As FileDialog
Dim mainWorkbook, sourceWorkbook As Workbook
Dim tempWorkSheet As Worksheet

Set mainWorkbook = Application.ActiveWorkbook
Set tempFileDialog = Application.FileDialog(msoFileDialogFilePicker)

'Allow the user to select multiple workbooks
tempFileDialog.AllowMultiSelect = True

numberOfFilesChosen = tempFileDialog.Show

'Loop through all selected workbooks
For i = 1 To tempFileDialog.SelectedItems.Count

'Open each workbook
Workbooks.Open tempFileDialog.SelectedItems(i)

Set sourceWorkbook = ActiveWorkbook

'Copy each worksheet to the end of the main workbook
For Each tempWorkSheet In sourceWorkbook.Worksheets
tempWorkSheet.Copy after:=mainWorkbook.Sheets(mainWorkbook.Worksheets.Count)
Next tempWorkSheet

'Close the source workbook
sourceWorkbook.Close
Next i

End Sub

p45cal
02-18-2020, 12:13 PM
Try submerging your files this way:
Sub mergeFiles()
Dim numberOfFilesChosen, i As Integer
Dim tempFileDialog As FileDialog
Dim mainWorkbook, sourceWorkbook As Workbook
Dim tempWorkSheet As Worksheet

Set mainWorkbook = Workbooks.Add
Set Destn = mainWorkbook.Sheets(1).Cells(1)
Set tempFileDialog = Application.FileDialog(msoFileDialogFilePicker)

'Allow the user to select multiple workbooks
tempFileDialog.AllowMultiSelect = True
numberOfFilesChosen = tempFileDialog.Show
'Loop through all selected workbooks
For i = 1 To tempFileDialog.SelectedItems.Count
'Open each workbook
Set sourceWorkbook = Workbooks.Open(tempFileDialog.SelectedItems(i))
'Copy 1st row of each worksheet's used range to sheet 1 of the new workbook workbook:
For Each tempWorkSheet In sourceWorkbook.Worksheets
tempWorkSheet.UsedRange.Rows(1).Copy Destn
Set Destn = Destn.Offset(1)
Next tempWorkSheet
sourceWorkbook.Close False
Next i
End Sub

nimesh29
02-18-2020, 12:40 PM
P45cal,
I will have header in the Master workbook so, I like to get all copied data starting 3rd row. currently it starts pasting the copied data in A1.

nimesh29
02-18-2020, 01:34 PM
P45cal:
I was able to figure it out, below is the final version of the code with few changes.
Original code (posted by P45cal in post #4) merged all data into New workbook and pasted the data starting in A1. I already have Master workbook that I want to use with the Header Row.
This accounts for using existing Workbook and adjusting starting row for pasting data.
I am also using Command button to run this Macro.


Thanks for your help P45cal.


Sub mergeFiles()Dim numberOfFilesChosen, i As Integer
Dim tempFileDialog As FileDialog
Dim mainWorkbook, sourceWorkbook As Workbook
Dim tempWorkSheet As Worksheet



Set mainWorkbook = Application.ActiveWorkbook
Set destn = mainWorkbook.Sheets(1).Cells(3, 3)
Set tempFileDialog = Application.FileDialog(msoFileDialogFilePicker)

'Allow the user to select multiple workbooks
tempFileDialog.AllowMultiSelect = True
numberOfFilesChosen = tempFileDialog.Show


'Loop through all selected workbooks
For i = 1 To tempFileDialog.SelectedItems.Count


'Open each workbook
Set sourceWorkbook = Workbooks.Open(tempFileDialog.SelectedItems(i))

'Copy 1st row of each worksheet's used range to sheet 1 of the new workbook workbook:
For Each tempWorkSheet In sourceWorkbook.Worksheets
tempWorkSheet.UsedRange.Rows(1).Copy destn
Set destn = destn.Offset(1)


Next tempWorkSheet
sourceWorkbook.Close False
Next i
End Sub

nimesh29
02-18-2020, 02:48 PM
p45cal:
Above code works great but, running into few issue and like to the code that includes;
-I want to specify the directory where the files are located in the VBA (automates the file selection)
-I only want to collect data from Sheet1 in multi-sheet workbook. It seems some the workbooks have multiple worksheet but, I only data from SHEET1.
-And like to ADD on to the previously collected data and not replace it or delete it.

Not sure if I could use any part of the above code?:think:

p45cal
02-18-2020, 03:48 PM
Sub mergeFiles2()
Dim numberOfFilesChosen, rngLr As Range, Destn As Range, fname
Dim tempFileDialog As FileDialog
Dim mainWorkbook

Set mainWorkbook = Application.ActiveWorkbook
With mainWorkbook.Sheets(1)
Set rngLr = .Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious)
If rngLr Is Nothing Then 'then it's an empty sheet.
Set Destn = .Cells(3, 3)
Else
Set Destn = .Cells(Application.Max(rngLr.Row + 1, 3), 3)
End If
End With
Set tempFileDialog = Application.FileDialog(msoFileDialogFilePicker)
'Allow the user to select multiple workbooks
tempFileDialog.AllowMultiSelect = True
tempFileDialog.InitialFileName = "C:\Users\Public\Documents\"
numberOfFilesChosen = tempFileDialog.Show

'Loop through all selected workbooks
For Each fname In tempFileDialog.SelectedItems
With Workbooks.Open(fname)
.Worksheets(1).UsedRange.Rows(1).Copy Destn 'or:
'.Worksheets("Sheet1").UsedRange.Rows(1).Copy Destn 'but you have to be sure there is a sheet with that name.
.Close False
End With
Set Destn = Destn.Offset(1)
Next fname
End Sub

nimesh29
02-19-2020, 07:36 AM
p45cal, this works great. Is there a way to assign a directory path within the code? This way when you open the master file all need to do is hit the button and data get populated without selecting files manually.

p45cal
02-19-2020, 09:39 AM
List all the file extensions that you want to have included in the process. (eg. xls, xlsm, csv)

nimesh29
02-19-2020, 10:21 AM
List all the file extensions that you want to have included in the process. (eg. xls, xlsm, csv)

Not sure where to add list this out? I add the file extension to the path but, i still need to select the files manually...


tempFileDialog.InitialFileName = "C:\Users\Desktop\TEST\DATA\*.xlsx"

I looked into other VBA examples for selecting all files in the directory but, couldn't get it to work.

p45cal
02-19-2020, 11:19 AM
I'm asking you to put a list here, in a messsage, so that I can devise a way of getting the files that you want processed, processed.

nimesh29
02-19-2020, 11:27 AM
Sorry, my bad :doh:
All my data files will have *.xlsx file extension.

p45cal
02-19-2020, 12:39 PM
Sub mergeFiles3()
Dim mainWorkbook, myPath, rngLr, Destn As Range, fname

myPath = "C:\Users\Public\Documents\" 'adjust

Set mainWorkbook = Application.ActiveWorkbook
With mainWorkbook.Sheets(1)
'.Activate
Set rngLr = .Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious)
If rngLr Is Nothing Then 'then it's an empty sheet.
Set Destn = .Cells(3, 3)
Else
Set Destn = .Cells(Application.Max(rngLr.Row + 1, 3), 3)
End If
End With

fname = Dir(myPath & "*.xlsx")
Do While fname <> ""
With Workbooks.Open(myPath & fname)
.Worksheets(1).UsedRange.Rows(1).Copy Destn
.Close False
End With
Set Destn = Destn.Offset(1)
fname = Dir()
Loop
End Sub

nimesh29
02-19-2020, 01:39 PM
p45cal, this is Perfect thank you very much! :bow:



Sub mergeFiles3()
Dim mainWorkbook, myPath, rngLr, Destn As Range, fname

myPath = "C:\Users\Public\Documents\" 'adjust

Set mainWorkbook = Application.ActiveWorkbook
With mainWorkbook.Sheets(1)
'.Activate
Set rngLr = .Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious)
If rngLr Is Nothing Then 'then it's an empty sheet.
Set Destn = .Cells(3, 3)
Else
Set Destn = .Cells(Application.Max(rngLr.Row + 1, 3), 3)
End If
End With

fname = Dir(myPath & "*.xlsx")
Do While fname <> ""
With Workbooks.Open(myPath & fname)
.Worksheets(1).UsedRange.Rows(1).Copy Destn
.Close False
End With
Set Destn = Destn.Offset(1)
fname = Dir()
Loop
End Sub