VBA: Split out Worksheets to individual Workbooks

rezacs

New Member
Joined
Sep 24, 2018
Messages
22
I have a workbook that has 14 worksheets. I'm looking for some code that will split these worksheets out into individual workbooks while retaining formatting.

I did find some code that does essentially what I am looking for:

Code:
Sub Splitbook()
'Updateby20140612
Dim xPath As String
xPath = "C:\Users\user\Desktop\Test"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each xWs In ThisWorkbook.Sheets
    xWs.Copy
    Application.ActiveWorkbook.SaveAs Filename:=xPath & "\" & xWs.Name & ".xlsx"
    Application.ActiveWorkbook.Close False
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Unfortunately I also need to tell it to ignore 4 of the worksheets and only break 10 of them out into workbooks.
I tried including the following If statement to no avail:

Code:
For Each xWs In ThisWorkbook.Sheets
    If xWs.Value <> "foo" Then
        xWs.Copy
Any help would be appreciated.
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
33,722
Office Version
365
Platform
Windows
How about
Code:
For Each xWs In ThisWorkbook.Sheets
   Select Case xWs.Name
      Case "[COLOR=#ff0000]abc[/COLOR]", "[COLOR=#ff0000]xyz[/COLOR]", "[COLOR=#ff0000]SPQR[/COLOR]"
      Case Else
         xWs.Copy
         Application.ActiveWorkbook.SaveAs filename:=XPath & "\" & xWs.Name & ".xlsx"
         Application.ActiveWorkbook.Close False
   End Select
Next
Change values in red to match the sheet names you DON'T want to copy
 

rezacs

New Member
Joined
Sep 24, 2018
Messages
22
That works perfect, just what I needed.

Problem solved.

Thank you very much.
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
33,722
Office Version
365
Platform
Windows
You're welcome & thanks for the feedback
 

Forum statistics

Threads
1,085,513
Messages
5,384,104
Members
401,881
Latest member
Dato

Some videos you may like

This Week's Hot Topics

Top