Split Worksheets Into Separate Workbooks

excelbytes

Active Member
Joined
Dec 11, 2014
Messages
291
Office Version
  1. 365
Platform
  1. Windows
I found this code to split worksheets into separate workbooks:

VBA 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

How do I modify it based on two criteria:

1) I want all the split workbooks to be saved into a different folder
2) I only want selected worksheets to be split into separate files

Thanks.
 

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)
Thanks for posting on the forum.

Try the following fit:
VBA Code:
Sub SplitEachWorksheet()
  Dim FPath As String
  Dim ws As Worksheet
  
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  
  With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Select Folder"
    If .Show <> -1 Then Exit Sub
    FPath = .SelectedItems(1)
  End With
  
  For Each ws In ThisWorkbook.Windows(1).SelectedSheets
    ws.Copy
    Application.ActiveWorkbook.SaveAs Filename:=FPath & "\" & ws.Name & ".xlsx"
    Application.ActiveWorkbook.Close False
  Next
  
  Application.DisplayAlerts = True
  Application.ScreenUpdating = True
End Sub

Let me know the result and I'll get back to you as soon as I can.
Sincerely
Dante Amor
 
Upvote 0
DanteAmor, thanks for the quick response. I need to clarify my request a bit more. I want to hard code into the code exactly where I want the saved files to go. Also, is there a way to indicate that I only want sheet2, sheet3, sheet4, & sheet5, for example, to be saved (their actual file names would be different, see attached image)?
 

Attachments

  • Sheets.png
    Sheets.png
    10.6 KB · Views: 11
Upvote 0
Please try the new code.

Note: But you have to update the folder name in the code.

VBA Code:
Sub SplitEachWorksheet()
  Dim FPath As String
  Dim sh As Worksheet
  Dim arr As Variant
  
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  
  FPath = "C:\trabajo\files"
  arr = Array("Sheet2", "Sheet3", "Sheet4", "Sheet5")
  
  For Each sh In Sheets
    If InStr(1, Join(arr, ","), sh.CodeName, vbTextCompare) > 0 Then
      sh.Copy
      Application.ActiveWorkbook.SaveAs Filename:=FPath & "\" & sh.Name & ".xlsx"
      Application.ActiveWorkbook.Close False
    End If
  Next
  
  Application.DisplayAlerts = True
  Application.ScreenUpdating = True
End Sub

Let me know the result and I'll get back to you as soon as I can.
Sincerely
Dante Amor
 
Upvote 0
Solution
Dante Amor, I've run into one other snag, maybe you can help. Now that I've split the worksheets into separate workbooks, I now need to take certain workbooks and combine them as worksheets into one new workbook. I have four folders to do this with. Even though I've copied the code and just made path changes, three of the four work fine but one has a minor snag that I hope you can help me figure out. Here is the code of one that works correctly:

VBA Code:
Sub CombineHeadcount()

Dim Path As String
Dim Filename As String
Dim Sheet As Worksheet

Application.ScreenUpdating = False

Path = "C:\Users\mremp\OneDrive\Documents\Excel Stuff\Excel Help\Edna\B 2 Gold\SheetSplit\Headcount\"
Filename = Dir(Path & "*.xlsx")

Do While Filename <> ""
Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
    For Each Sheet In ActiveWorkbook.Sheets
        Sheet.Copy After:=ThisWorkbook.Sheets(1)
    Next Sheet
Workbooks(Filename).Close
Filename = Dir()
Loop

Application.ScreenUpdating = True

End Sub

Here is the code of the one that is giving me an issue:

VBA Code:
Sub CombineTurnover()

Dim Path As String
Dim Filename As String
Dim Sheet As Worksheet

Application.ScreenUpdating = False

Path = "C:\Users\mremp\OneDrive\Documents\Excel Stuff\Excel Help\Edna\B 2 Gold\SheetSplit\Turnover\"
Filename = Dir(Path & "*.xlsx")

Do While Filename <> ""
Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
    For Each Sheet In ActiveWorkbook.Sheets
        Sheet.Copy After:=ThisWorkbook.Sheets(1)
    Next Sheet
Workbooks(Filename).Close
Filename = Dir()
Loop

Application.ScreenUpdating = True

End Sub

To me they appear to be identical. Here is what's happening. On the ones that work fine, they pull in all the workbooks as worksheets into one workbook, then I can save it as a separate file. In the one that is giving me a problem, it opens each file and after it copies the file as a worksheet into the new workbook, it asks me if I want to save the changes to it. There are a total of 12 files, so I need to say Cancel after each one. Ultimately it results in combining all the files into one, but why it asks me to save the changes for each one on this one and not the other three I can't figure. Maybe it's not the code but something else I'm not seeing. Any thoughts?
 
Upvote 0
Dante Amor, never mind, I figured it out. On the one worksheet there was a formula linking it to another worksheet, so each time those files were moved to a new workbook, it re-established the connection to another workbook and required it to be saved. Sorry to bother you on this. Thanks again for your help.
 
Upvote 0

Forum statistics

Threads
1,223,099
Messages
6,170,107
Members
452,302
Latest member
TaMere

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top