Combine Multiple Individual Sheets to one workbook

[rambostine202]

Hello people,

I am totally new here and have decent knowledge of excel and creating a MACRO at basic levels. I am not familiar with how to properly formulate my request, but I will try. If someone could please help me solve this I would be grateful.

I managed to write something to convert around 50 Text files (.txt) to .xlsx type.
So now I have 50 .xlsx files/individual sheets that I want to merge into one Excel Workbook that contains the 50 sheets. NOT combine the 50 individual sheets on 1 sheet in a workbook, but have 50 sheets in just one workbook.

for ease I am renaming them simply by selecting all, the individual xlsx files in one folder just as follows (they are all in the same folder)
-1(1).xlsx
-1(2).xlsx
-1(3).xlsx
...
-1(50).xlsx

So I have 50 files that I will generate multiple times 50 files in txt document and then have to merge in one Workbook with 50 tabs/sheets.

Can someone please guide me.

Thanks in advance.

 

[Logit]

.
Give this a try :

Option Explicit


Sub MergeMultiSheets()


    Dim FilePath, Path As String
    Dim FileName As String
    Dim Wkb As Workbook
    Dim WS As Worksheet
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    FilePath = GetFile("C:\")
    Path = Left(FilePath, InStrRev(FilePath, "\"))
    FileName = Dir(Path & "\*.xlsx", vbNormal)
  
    Do Until FileName = ""
        Set Wkb = Workbooks.Open(FileName:=Path & "\" & FileName)


        For Each WS In Wkb.Worksheets
            WS.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
        Next WS


        Wkb.Close False
        FileName = Dir()
    Loop


    Application.EnableEvents = True
    Application.ScreenUpdating = True


    Application.DisplayAlerts = False
        Worksheets("Sheet1").Delete
    Application.DisplayAlerts = True
End Sub


Function GetFile(strPath As String) As String


    Dim File As FileDialog
    Dim sItem As String
    Set File = Application.FileDialog(msoFileDialogFilePicker)
    With File
        .Title = "Select a File"
        .AllowMultiSelect = False
        .Filters.Clear
        .Filters.Add "Excel files only", "*.xls; *.xlsx"
        .InitialFileName = strPath
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With
NextCode:
    GetFile = sItem
    Set File = Nothing


End Function

Paste a Command Button on Sheet 1 of your Masterworkbook connected to the macro.
When the FileDialog is shown, move to the folder holding all of the .xlsx files. Select one of those
files and press OK. No need to select more than one of the .xlsx files.

Be certain only the .xlsx files you want copied are in the folder and nothing else.

 

[rambostine202]

Logit, you Sir are TREMENDOUSLY AWESOME!

Exactly what I needed. I spent soo much time on google and youtube trying to find this but couldn't get exactly what I wanted.

Words cannot express my gratitude.

May you always attain what it is you seek.

This is so great. Looking forward to creating all my files now.

Thank you so much.

 

[Logit]

You are welcome. Trust it works as you need it to.