Help with VBA Code Split Worksheets

[lisaming]

I have a working VBA code however, I am trying to change it for "ThisWorkBook" to where I can choose any file and run the macro to split the worksheets into separate files.

Pull this from another macro:
Private Sub Workbook_Open()
fnameList = Application.GetOpenFilename(FileFilter:="Microsoft Excel Workbooks (*.xls;*.xlsx;*.xlsm),*.xls;*.xlsx;*.xlsm", Title:="Choose Excel files to merge", MultiSelect:=False)

Existing Code:
Sub SplitEachWorksheet()
Dim FPath As String
FPath = Application.ActiveWorkbook.Path
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each ws In ThisWorkbook.Sheets
ws.Copy
Application.ActiveWorkbook.SaveAs Filename:=FPath & "\" & ws.Name & ".xlsx"
Application.ActiveWorkbook.Close False
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

 

[Norie]

Perhaps something like this.

Sub SplitEachWorksheet()
Dim wb As Workbook
Dim fnameList As String
Dim FPath As String

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    fnameList = Application.GetOpenFilename(FileFilter:="Microsoft Excel Workbooks (*.xls;*.xlsx;*.xlsm),*.xls;*.xlsx;*.xlsm", Title:="Choose Excel file to split", MultiSelect:=False)

    Set wb = Workbooks.Open(fnameList
    FPath = wb.Path

    For Each ws In wb.Sheets
        ws.Copy
        Application.ActiveWorkbook.SaveAs Filename:=FPath & "\" & ws.Name & ".xlsx"
        Application.ActiveWorkbook.Close False
    Next

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

 

[lisaming]

Perhaps something like this.

Sub SplitEachWorksheet()
Dim wb As Workbook
Dim fnameList As String
Dim FPath As String

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    fnameList = Application.GetOpenFilename(FileFilter:="Microsoft Excel Workbooks (*.xls;*.xlsx;*.xlsm),*.xls;*.xlsx;*.xlsm", Title:="Choose Excel file to split", MultiSelect:=False)

    Set wb = Workbooks.Open(fnameList
    FPath = wb.Path

    For Each ws In wb.Sheets
        ws.Copy
        Application.ActiveWorkbook.SaveAs Filename:=FPath & "\" & ws.Name & ".xlsx"
        Application.ActiveWorkbook.Close False
    Next

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

Thanks for the feedback, however I tried it and it didnt work. How do i incorporate the " Private Sub Workbook_Open() " code into the current one so that I can select the file that needs to be split?

 

[Norie]

How did it not work?

Did yo fix the typo?

 

[JLGWhiz]

How do i incorporate the " Private Sub Workbook_Open() " code into the current one so that I can select the file that needs to be split?

This is a confusing question, because it does not coincide with this statement.

I am trying to change it for "ThisWorkBook" to where I can choose any file and run the macro to split the worksheets into separate files.

Can you be a little more explicit in what you want to do. Pretend you have no code at all and then explain what you want.

 

[lisaming]

How did it not work?

Did yo fix the typo?

I did fix the typo, and it didnt work.

 

[lisaming]

This is a confusing question, because it does not coincide with this statement.


Can you be a little more explicit in what you want to do. Pretend you have no code at all and then explain what you want.

Sure thing, I need a macro that will split any workbook (with multiple worksheets) into separate files. The macro will need to prompt the User to select the file to split; and save the separate worksheets in the same location as where the original file was selected from.

Hope this helps clarify.

 

[JLGWhiz]

After adding the right parenthesis to the Workbooks.Open statement, @Norie code ran without error and produced desired results for me. I ran the code from code module1 of my workbook. It opens the GetFilename dialo9g box, where I selected a file name and clicked 'Open'. The code then opened the selected workbook, copied the sheets to produce new workbooks, saving each one to the original directory and closing them in turn. What parrt of this process is not working for you.