Workbook Merger

Sub MergeWorkbooks()
    Dim folderPath As String
    Dim fileName As String
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim targetWb As Workbook
    Dim fileCount As Integer

    ' Get folder containing workbooks to merge
    folderPath = InputBox("Enter folder path containing workbooks to merge:")
    If folderPath = "" Then Exit Sub

    ' Ensure path ends with backslash
    If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"

    ' Create new workbook for merged data
    Set targetWb = Workbooks.Add
    targetWb.Sheets(1).Name = "Index"

    ' Add index header
    With targetWb.Sheets("Index")
        .Range("A1").Value = "Merged Workbooks Index"
        .Range("A2").Value = "Sheet Name"
        .Range("B2").Value = "Source File"
        .Range("C2").Value = "Merge Date"
        .Range("A1:C2").Font.Bold = True
    End With

    fileCount = 0
    fileName = Dir(folderPath & "*.xlsx")

    Application.ScreenUpdating = False

    Do While fileName <> ""
        If fileName <> targetWb.Name Then
            Set wb = Workbooks.Open(folderPath & fileName)

            ' Copy each sheet from source workbook
            For Each ws In wb.Worksheets
                ws.Copy After:=targetWb.Sheets(targetWb.Sheets.Count)
                ' Rename sheet to include source filename
                targetWb.Sheets(targetWb.Sheets.Count).Name = Left(fileName, InStrRev(fileName, ".") - 1) & "_" & ws.Name

                ' Add to index
                With targetWb.Sheets("Index")
                    .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Value = targetWb.Sheets(targetWb.Sheets.Count).Name
                    .Cells(.Rows.Count, 1).End(xlUp).Offset(0, 1).Value = fileName
                    .Cells(.Rows.Count, 1).End(xlUp).Offset(0, 2).Value = Now
                End With
            Next ws

            wb.Close SaveChanges:=False
            fileCount = fileCount + 1
        End If

        fileName = Dir()
    Loop

    Application.ScreenUpdating = True

    MsgBox "Merged " & fileCount & " workbooks successfully!"
End Sub