New

Sub CombineExcelFilesColumnWise()

   Dim wsMaster As Worksheet
   Dim dictHeaders As Object
   Dim fDialog As FileDialog
   Dim folderPath As String
   Dim fileName As String
   Dim wbTemp As Workbook
   Dim wsTemp As Worksheet
   Dim header As String
   Dim colMap As Object
   Dim i As Long, j As Long
   Dim lastCol As Long, lastRow As Long
   Dim pasteRow As Long
   Dim headerIndex As Long
   Dim keyIndex As Long
   Dim keyArray As Variant

   Application.ScreenUpdating = False
   Application.DisplayAlerts = False

   Set dictHeaders = CreateObject("Scripting.Dictionary")

   ' Ask user to select folder
   Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
   With fDialog
       .Title = "Select Folder Containing Excel Files"
       If .Show <> -1 Then Exit Sub ' User cancelled
       folderPath = .SelectedItems(1) & "\"
   End With

   ' Use active sheet as master
   Set wsMaster = ThisWorkbook.Sheets(1)
   wsMaster.Cells.Clear

   ' Step 1: Collect unique headers from all Excel files
   fileName = Dir(folderPath & "*.xls*")
   Do While fileName <> ""
       Set wbTemp = Workbooks.Open(folderPath & fileName, ReadOnly:=True)
       Set wsTemp = wbTemp.Sheets(1)

       lastCol = wsTemp.Cells(1, wsTemp.Columns.Count).End(xlToLeft).Column
       For i = 1 To lastCol
           header = Trim(wsTemp.Cells(1, i).Value)
           If Len(header) > 0 Then
               If Not dictHeaders.exists(header) Then
                   dictHeaders.Add header, dictHeaders.Count + 1
               End If
           End If
       Next i

       wbTemp.Close False
       fileName = Dir
   Loop

   ' Step 2: Write master headers (starting from column B)
   wsMaster.Cells(1, 1).Value = "Source File" ' Column A
   For i = 0 To dictHeaders.Count - 1
       wsMaster.Cells(1, i + 2).Value = dictHeaders.Keys()(i)
   Next i

   ' Step 3: Append data with source file info
   pasteRow = 2
   fileName = Dir(folderPath & "*.xls*")
   Do While fileName <> ""
       Set wbTemp = Workbooks.Open(folderPath & fileName, ReadOnly:=True)
       Set wsTemp = wbTemp.Sheets(1)

       ' Build column map for this file
       Set colMap = CreateObject("Scripting.Dictionary")
       lastCol = wsTemp.Cells(1, wsTemp.Columns.Count).End(xlToLeft).Column
       For i = 1 To lastCol
           header = Trim(wsTemp.Cells(1, i).Value)
           If dictHeaders.exists(header) Then
               ' Shift column by 1 (because master data starts from Column B)
               colMap.Add i, dictHeaders(header) + 1
           End If
       Next i

       ' Copy data row-wise
       lastRow = wsTemp.Cells(wsTemp.Rows.Count, 1).End(xlUp).Row
       For i = 2 To lastRow
           ' Add source file name in column A
           wsMaster.Cells(pasteRow, 1).Value = fileName

           keyArray = colMap.Keys
           For keyIndex = LBound(keyArray) To UBound(keyArray)
               j = keyArray(keyIndex)
               headerIndex = colMap(j)
               wsMaster.Cells(pasteRow, headerIndex).Value = wsTemp.Cells(i, j).Value
           Next keyIndex
           pasteRow = pasteRow + 1
       Next i

       wbTemp.Close False
       fileName = Dir
   Loop

   Application.ScreenUpdating = True
   Application.DisplayAlerts = True

   MsgBox "Files combined successfully!", vbInformation

End Sub