Combine multiple Excel workbooks into a single workbook

Question

I am a novice at Visual Basic. I can use either Excel 2010 or Excel 2013 for this task.

I have dozens of workbooks with data on the first worksheet of each. For example One.xlsx, Two.xlsx, Three.xlsx, Four.xlsx each contain information on their respective Sheet1.

I need the information on Sheet1 from each workbook to be combined into a single workbook with sheets that are named from the file name of the original workbook. So for example combined.xlsx would have 4 sheets named One, Two, Three, Four. In every case all information on the underlying worksheets should be copied and combined in the new Workbook as shown below.

The Format I need

enter image description here

I found this Macro / Add-In online that gets me close to what I need using the open files add in choice.

http://www.excelbee.com/merge-excel-sheets-2010-2007-2013#close

The Open Files Add-In successfully allows me to aggregate the various Workbook's worksheets into a single workbook. However the tabs are not named from the name of the original file.

Correct aggregation of sheets, but incorrect worksheet names.

enter image description here

For now all the underlying Workbooks will be in the same folder. The ability to browse and select the files would be nice if this ever changes but if that is too difficult, just indicating the directory path in the Visual Basic code would work. As far as the resultant combined output probably ought to be a new workbook, the filename of the new workbook isn't that important. It could be called combined.xlsx for example.

Jay C Jay C · Accepted Answer · 2014-10-20T20:27:23

The following accomplishes the task.

Option Explicit

Private Sub CommandButton1_Click()

Dim directory As String, fileName As String, sheet As Worksheet, total As Integer
Dim WrdArray() As String

Application.ScreenUpdating = False
Application.DisplayAlerts = False

directory = "c:\test\"
fileName = Dir(directory & "*.xl??")

Do While fileName <> ""
    Workbooks.Open (directory & fileName)
        WrdArray() = Split(fileName, ".")
        For Each sheet In Workbooks(fileName).Worksheets
        Workbooks(fileName).ActiveSheet.Name = WrdArray(0)
            total = Workbooks("import-sheets.xlsm").Worksheets.Count
            Workbooks(fileName).Worksheets(sheet.Name).Copy after:=Workbooks("import-sheets.xlsm").Worksheets(total)

            GoTo exitFor:

        Next sheet

exitFor:
    Workbooks(fileName).Close
    fileName = Dir()
Loop

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

Combine multiple Excel workbooks into a single workbook

2 Answers