Merge Multiple Excel files into a Single File - Get Specific Column

Sub MergeExcelFiles()
    Dim Path As String
    Dim Filename As String
    Dim wbSource As Workbook
    Dim ws As Worksheet
    Dim newSheet As Worksheet
    Dim lastCol As Long
    Dim lastRow As Long
    Dim copyRange As Range
    Dim isFirstFile As Boolean
    Dim baseSheetName As String
    Dim sheetCounter As Integer
    isFirstFile = True

    ' Set the path to the folder containing the Excel files
    Path = "C:\Your\Folder\Path\Here\"  ' Update this to your folder path
    
    ' Get the first Excel file from the directory
    Filename = Dir(Path & "*.xlsx")
    
    ' Loop through all Excel files in the folder
    Do While Filename <> ""
        ' Open the current Excel file
        Set wbSource = Workbooks.Open(Path & Filename, ReadOnly:=True)
        
        ' Get the base sheet name from the file name (without extension)
        baseSheetName = Left(Filename, InStrRev(Filename, ".") - 1)
        sheetCounter = 1
        
        ' Loop through each sheet in the opened workbook
        For Each ws In wbSource.Sheets
            ' Copy all columns from the sheets in the first file
            If isFirstFile Then
                ws.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
                ' Rename the sheet based on the file name
                ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = baseSheetName & "_" & ws.Name
            Else
                ' Create a new sheet in the destination workbook
                Set newSheet = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))

                ' Find the last row and column in the source sheet
                lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
                lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
                
                ' Copy only the columns from the second column onward
                Set copyRange = ws.Range(ws.Cells(1, 2), ws.Cells(lastRow, lastCol))
                copyRange.Copy Destination:=newSheet.Cells(1, 1)
                
                ' Rename the new sheet based on the file name and sheet counter
                newSheet.Name = baseSheetName & "_part_" & sheetCounter
                sheetCounter = sheetCounter + 1
            End If
        Next ws
        
        ' Close the source workbook without saving
        wbSource.Close False
        
        ' Move to the next file
        Filename = Dir()
        ' Set isFirstFile to False after the first file is processed
        isFirstFile = False
    Loop
    
    MsgBox "Sheets have been merged into this workbook."
End Sub

How It Works

1. Naming the Sheets:

   • For the first file, the sheet names will be the original sheet name prefixed with the Excel file name.
   • For subsequent files, new sheets will be named based on the Excel file name, followed by "part" and a counter (e.g., "FileName_part_1").

2. Base Sheet Name:

   • baseSheetName is derived from the filename of the Excel file (excluding the extension). This name is used as a prefix for the new sheet names.

3. Sheet Counter:

   • sheetCounter is used to differentiate between multiple sheets copied from the same Excel file.

Steps to Use the Code

1. Insert the VBA Code:

   • Open the VBA editor in Excel, insert a module, and paste the updated code.

2. Set the Path:

   • Update the Path variable to point to the folder where your Excel files are stored.

3. Run the Macro:

   • Press F5 or go to Run > Run Sub/UserForm to execute the macro.

4. Save the Workbook:

   • After the macro completes, save your workbook. The sheets will be named according to the file they came from.

This will result in the merged workbook having sheets named based on the original Excel file names, allowing you to easily identify the source of each sheet.