How to merge multiple sheets of Excel files to one Excel file?

Question

I need to merge hundred Excel files into one Excel file. Each Excel file needs to be merged into its own worksheet in the workbook and the destination worksheet needs to have the name of the original file (minus the extension). Is this possible?

Answer 1

Well, it doesn't seem like you've put any effort into this, but since I already have these macros written, I'll supply them for anyone else that is searching. These were written in excel 2007 and were part of a larger process.

It is important to note that this will fail if any of your file names have over 31 characters, excel has a character limit for sheet names

Combine the files into one with the name of the worksheets being set to the file name -

Sub CombineWSs()
Dim wbDst As Workbook
Dim wbSrc As Workbook
Dim wsSrc As Worksheet
Dim MyPath As String
Dim strFilename As String

    Application.DisplayAlerts = False
    Application.EnableEvents = False
    Application.ScreenUpdating = False

    MyPath = "C:\Documents and Settings\path\to"
    Set wbDst = ThisWorkbook
    strFilename = Dir(MyPath & "\*.xls", vbNormal)

    If Len(strFilename) = 0 Then Exit Sub

    Do Until strFilename = ""

            Set wbSrc = Workbooks.Open(Filename:=MyPath & "\" & strFilename)

            Set wsSrc = wbSrc.Worksheets(1)

            wsSrc.Copy After:=wbDst.Worksheets(wbDst.Worksheets.Count)

            wbSrc.Close False

        strFilename = Dir()

    Loop
    wbDst.Worksheets(1).Delete

    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True

End Sub

Now iterate through the sheets to remove the last five characters of the sheet name: .xlsx

Sub RenameWS()
Application.ScreenUpdating = False
Dim strName As String
Dim intLength As Integer

For Each Sheet In ActiveWorkbook.Worksheets
    strName = Sheet.Name
    intLength = Len(strName)
    strName = Left(strName, intLength - 5)
    Sheet.Name = strName

Next
Application.ScreenUpdating = True
End Sub