How do I merge multiple selected excel files in VBA? - vba

Question

I'm new with VBA and I'm wondering on how to merge multiple selected excel files using VBA. I tried coding the part of selecting files. I've researched and tried copying the codes on the internet and did some editing. I learned that you can add filters so I did that. But sometimes, the excel files won't show even if I added the correct filter (based on what I've researched). I really need to merge multiple selected excel files. I hope you can help me.
I'm using a userform, btw. One button that would allow to select and merge the selected files. And if possible, I want the user to see the path of the selected files. I don't know yet on how to do that, or what tool should I use, like listbox or what. Thanks in advance!
Update!
I have a code for selecting multiple excel files. What I need now is how to merge the files that I selected.
Dim FileNames As Variant
Dim Msg As String
Dim I As Integer
FileNames = Application.GetOpenFilename(MultiSelect:=True)
If IsArray(FileNames) Then
Msg = "You selected:" & vbNewLine
For I = LBound(FileNames) To UBound(FileNames)
Msg = Msg & FileNames(I) & vbNewLine
Next I
MsgBox Msg
tbPath.Value = Msg
Else
MsgBox "No files were selected."
End If

Answer 1

Well here is my code... hope this help you.
Sub mergeAllFiles()
Dim This As Workbook 'Store the book with the macro
Dim TmpB As Workbook 'store the book that has the sheets (one per book)
Dim AllB As Workbook 'book to send all the books
Dim sht As Worksheet 'the only sheet every book
Dim FileNames As Variant
Dim Msg As String
Dim I As Integer
Set This = ThisWorkbook
FileNames = Application.GetOpenFilename(MultiSelect:=True)
If IsArray(FileNames) Then
Workbooks.Add 'add a new book to store all the sheets
Set AllB = ActiveWorkbook
AllB.SaveAs This.Path & "\allSheetsInOne" & SetTimeName & ".xlsx", 51
'The function is to store a different name every time and avoid error
Msg = "You selected:" & vbNewLine
For I = LBound(FileNames) To UBound(FileNames)
Workbooks.Open Filename:=FileNames(I)
Set TmpB = ActiveWorkbook
TmpB.Activate
Set sht = ActiveSheet 'because you say that the book has only one sheet
sht.Copy Before:=AllB.Sheets(Sheets.Count) 'send it to the end of the sheets
TmpB.Close 'we don't need the book anymore
Set TmpB = Nothing 'empty the var to use it again
Set sht = Nothing
Msg = Msg & FileNames(I) & vbNewLine
Next I
MsgBox Msg
tbPath.Value = Msg
Else
MsgBox "No files were selected."
End If
End Sub
Function SetTimeName()
Dim YY
Dim MM
Dim DD
Dim HH
Dim MI
Dim SS
Dim TT
YY = Year(Date)
MM = Month(Date)
DD = Day(Date)
HH = Hour(Now)
MI = Minute(Now)
SS = Second(Now)
TT = Format(YY, "0000") & Format(MM, "00") & Format(DD, "00") & Format(HH, "00") & Format(MI, "00") & Format(SS, "00")
SetTimeName = TT
End Function
Tell me if is need it any improvement.

Answer 2

Use my code from here:
Multi-Select Files and open
Edit the code to suite your requirements.
Sub OPenMultipleWorkbooks()
'Open Multiple .xlsx files
Application.DisplayAlerts = False
Dim wb As Workbook, bk As Workbook
Dim sh As Worksheet
Dim GetFile As Variant, Ws As Worksheet
Set wb = ThisWorkbook
Set sh = wb.ActiveSheet
For Each Sheet In Sheets
If Sheet.Name <> sh.Name Then Sheet.Delete
Next Sheet
ChDrive "C:"
Application.ScreenUpdating = False
GetFile = Application.GetOpenFilename(FileFilter:="XLSX(*.xlsx), *.xlsx", Title:="Open XLSX- File", MultiSelect:=True)
On Error Resume Next
If GetFile <> False Then
On Error GoTo 0
For i = 1 To UBound(GetFile)
Set bk = Workbooks.Open(GetFile(i))
Sheets(1).Move Before:=wb.Sheets(1)
bk.Close True
Next i
End If
End Sub