Merge Many excel files to one new file with different sheet

Question

I am trying to merge many excel files (workbooks) from a folder. My problem is that I want to move different sheets to the new excel file. At the moment my code can only move one sheet at the time from these different files.

Example: I have 3 excel files named

1.xlsx
2.xlsx
3.xlsx

all 3 files have 3 sheets in it and I want to take sheet1 from 1.xlsx and sheet1 and sheet2 from 2.xlsx and finally sheet3 from 3.xlsx and put in a new excel file.

My code at the moment can only takes one sheet (and same sheet number) from each file and put in the new file.

My code so fare:

Sub MergeMultiSheets()
Dim wbDst As Workbook
Dim wbSrc As Workbook
Dim wsSrc As Worksheet
Dim Path As String
Dim Filename As String

Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False
path = "C:\Users\*ChangeThis*\Desktop\merge" 
Set wbDst = Workbooks.Add(xlWBATWorksheet)
Filename = Dir(path & "\*.xlsx", vbNormal)

If Len(Filename) = 0 Then Exit Sub

Do Until Filename = ""
    Set wbSrc = Workbooks.Open(Filename:=path & "\" & Filename)

    sheet = 1
    Set wsSrc = wbSrc.Worksheets(sheet)
    wsSrc.Copy After:=wbDst.Worksheets(wbDst.Worksheets.Count)

    wbSrc.Close False
    Filename = Dir()
Loop
wbDst.Worksheets(1).Delete

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

End Sub

Many thank in advance

you must state the rule by which sheets are to be selected from all different files. in your example you gave the rule for 3 files each having 3 sheets: what if files are more (or less) than 3 and if any file has more (or less) than 3 sheets? — user3598756
@user3598756 I see your point, but it was an example just so other would have an idea what I wanted with this. — JessieQuick

Shai Rado Shai Rado · Accepted Answer · 2016-08-04T12:41:42

You need to loop through all the Sheets in the current Workbook found in your folder.

Try the code below:

Sub MergeMultiSheets()

Dim wbDst As Workbook
Dim wbSrc As Workbook
Dim wsSrc As Worksheet
Dim Path As String
Dim Filename As String

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

Path = "C:\Users\*ChangeThis*\Desktop\merge"    

Set wbDst = Workbooks.Add(xlWBATWorksheet)
Filename = Dir(Path & "\*.xlsx", vbNormal)

If Len(Filename) = 0 Then Exit Sub

Do Until Filename = ""
    Set wbSrc = Workbooks.Open(Filename:=Path & "\" & Filename)

    Sheet = 1
    ' ****** you need to loop on all sheets per Excel workbook found in Folder ******
    For Each wsSrc In wbSrc.Sheets        
        wsSrc.Copy After:=wbDst.Worksheets(wbDst.Worksheets.Count)        
    Next wsSrc

    wbSrc.Close False
    Filename = Dir()
Loop
wbDst.Worksheets(1).Delete

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

End Sub

Merge Many excel files to one new file with different sheet

1 Answers