• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

How to browse folder , select folder path and run merge multisheets?

J

jk51

Member


  1. Hi,

  1. Help please to modify VBA code below in excel 2010 for step 1 only with Step 2 is working. see below. :

    STEP 1
    Blank work sheet. Click button from excel sheet (Open folder) and browse and select folder path you want and run the merge multisheets. ( Note I don't want manually add folder path in the VBA code, I want to browse and select folder only and under the folder see number of excel file ready to merge multisheets all in 1 file.

  1. STEP 2
    "Merge all sheets in 1 file" - Merge all worksheets from multiple workbooks (3 files containing various number of sheets and different name some might be 2 or 3 or 4 sheets each. Note if sheet name are same e.g. sheet1 and another file contain sheet1 and merge you see output sheet1, sheet1(2) not overwrite)
For example :

1 folder contains 3 excel workbook files.
Excel workbook file 1 contains 2 sheets ("A","B")
Excel workbook file 2 contains 3 sheets ("B","D","E")
Excel workbook file 3 contains 2 sheets ("G","J")
Output:

New Excel workbook called "Mergemultisheets" with 7 sheets ("A","B","B(2)","D","E","G","J")
Message box say "Merge all completed".
**************************
Here is the VBA code for step 2: Mergeallsheets

Option Explicit
Sub MergeMultiSheets()
Dim Path As String
Dim FileName As String
Dim Wkb As Workbook
Dim WS As Worksheet
Application.EnableEvents = False
Application.ScreenUpdating = False
Path = "C:\TESTFOLDER\" 'Change as needed
FileName = Dir(Path & "\*.xlsx", vbNormal)
Do Until FileName = ""
Set Wkb = Workbooks.Open(FileName:=Path & "\" & FileName)
For Each WS In Wkb.Worksheets
WS.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
Next WS
Wkb.Close False
FileName = Dir()
Loop
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.DisplayAlerts = False
Sheet1.Delete
Application.DisplayAlerts = True
End Sub

**************************

Thank you,

BW

Mr Singh
 
Hi,

The following should work:
Code: 
Option Explicit
Sub MergeMultiSheets()

    Dim Path As String
    Dim FileName As String
    Dim Wkb As Workbook
    Dim WS As Worksheet
 
    Application.EnableEvents = False
    Application.ScreenUpdating = False
 
    Path = GetFolder("C:\")
    FileName = Dir(Path & "\*.xlsx", vbNormal)
 
    Do Until FileName = ""
        Set Wkb = Workbooks.Open(FileName:=Path & "\" & FileName)

        For Each WS In Wkb.Worksheets
            WS.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
        Next WS

        Wkb.Close False
        FileName = Dir()
    Loop

    Application.EnableEvents = True
    Application.ScreenUpdating = True

    Application.DisplayAlerts = False
        Sheet1.Delete
    Application.DisplayAlerts = True
 
End Sub

Function GetFolder(strPath As String) As String

    Dim fldr As FileDialog
    Dim sItem As String
 
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
 
    With fldr
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        .InitialFileName = strPath
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With
 
NextCode:
    GetFolder = sItem
    Set fldr = Nothing

End Function

Dialog box will open at "C:\" by default... you can also change it if you want!

I can't test it at the moment but you should be good to go.
Let me know if there is anything else I can help with.
 
Hi PCosta,

The programs works except 1 minor error and 1 comment to add.

The default worksheet file is 'sheet1'. When I ran the program, the line error stop at sheet1.delete.
The message box appear : compile error: variable not defined.

It works when you insert another sheet 2 and then run the program but sheet 2 will still be there and sheet1 delete. Can you help this error?

My comment when browsing the folder I can't see what files under the folder. I need to know what under the folder containing excel files (.xls or .xlsx). When I want the folder, it should pick up the folder path and run from there.

Thanks you for your efforts.

Bw

Mr Singh
 
Hi PCosta,

I fitted the error
Worksheets("Sheet1").Delete and the program is working deleted sheet1.

Can you answer my comment about browsing folder but not display files under the folder.

Thank you very much

Mr Singh
 
Hi,

Worksheets("Sheet1").Delete and the program is working deleted sheet1
Click to expand...

I only added the code for the folder picker... since you said Step 2 was working I didn't go through the code.... sorry :(.
Seems you got it though!

I can't see what files under the folder. I need to know what under the folder containing excel files (.xls or .xlsx)
Click to expand...

Browsing for the folder will not allow you to see the files (as far as I know).
The other option would be to browse for files instead: "Application.FileDialog(msoFileDialogFilePicker)"

This will allow you to see and select the file(s). You can even add an extension filter to only show / allow selection of ".xls" and ".xlsx" files.
However, this will return the selected file(s) full name, i.e., the path and the file name.
You would then need to "trim" this string to get the actual folder path.

If this approach is OK, please let me know if you need any help changing the code.
 
jk51 said:
Thanks for reply. Yes this is ok. Need help with the code as I am new to vba macros.
Click to expand...
Here you go

Again, untested... try it out a let me know if it is working as intended:
Code: 
Option Explicit
Sub MergeMultiSheets()

    Dim FilePath, Path As String
    Dim FileName As String
    Dim Wkb As Workbook
    Dim WS As Worksheet
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    FilePath = GetFile("C:\")
    Path = Left(FilePath, InStrRev(FilePath, "\"))
    FileName = Dir(Path & "\*.xlsx", vbNormal)
  
    Do Until FileName = ""
        Set Wkb = Workbooks.Open(FileName:=Path & "\" & FileName)

        For Each WS In Wkb.Worksheets
            WS.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
        Next WS

        Wkb.Close False
        FileName = Dir()
    Loop

    Application.EnableEvents = True
    Application.ScreenUpdating = True

    Application.DisplayAlerts = False
        Worksheets("Sheet1").Delete
    Application.DisplayAlerts = True
End Sub

Function GetFile(strPath As String) As String

    Dim File As FileDialog
    Dim sItem As String
    Set File = Application.FileDialog(msoFileDialogFilePicker)
    With File
        .Title = "Select a File"
        .AllowMultiSelect = False
        .Filters.Clear
        .Filters.Add "Excel files only", "*.xls; *.xlsx"
        .InitialFileName = strPath
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With
NextCode:
    GetFile = sItem
    Set File = Nothing

End Function

Cheers
 
You must log in or register to reply here.
Back
Top