How to split (copy) sheets from one workbook to individual workbooks?

[MariaR323]

So I have one workbook with about 50 worksheets (tabs). Is there a way to split each tab and save as their own workbook? Here's the quirk, the master workbook has one (lookup table) sheet that has to be copied with each of those other sheets.

Master Workbook (1 lookup tab + 49 tabs)
[lookup tab] [tab a] [tab b] [tab c] [tab d]....

So basically the [lookup tab] has to be copied with each of the rest of the tabs so I can save as a new workbook containing two tabs.

- new workbook 1 would contain [lookup tab] [tab a]
- new workbook 2 would contain [lookup tab] [tab b]
and so on...


I found the below VBA code in a search but I believe it's for single sheets only. Can anybody help?? I'd be very grateful as it would save me quite a bit of time.

Sub CreateNewWBS()
Dim wbThis As Workbook
Dim wbNew As Workbook
Dim ws As Worksheet
Dim strFilename As String

Set wbThis = ThisWorkbook
For Each ws In wbThis.Worksheets
strFilename = wbThis.Path & "/" & ws.Name
ws.Copy
Set wbNew = ActiveWorkbook
wbNew.SaveAs strFilename
wbNew.Close
Next ws
End Sub

 

[tonyyy]

MariaR323,

You might try adding the line in red...

Sub CreateNewWBS_1029835()
Dim wbThis As Workbook
Dim wbNew As Workbook
Dim ws As Worksheet
Dim strFilename As String

Set wbThis = ThisWorkbook
For Each ws In wbThis.Worksheets
    strFilename = wbThis.Path & "/" & ws.Name
    ws.Copy
    Set wbNew = ActiveWorkbook
    [COLOR=#ff0000]wbThis.Sheets("lookup").Copy before:=wbNew.Sheets(1) 'Change "lookup" to actual sheet name[/COLOR]
    wbNew.SaveAs strFilename
    wbNew.Close
Next ws
End Sub

Cheers,

tonyyy

 

[Fluff]

If your sheets have formulae pointing to the Lookup sheet, this might be a better way.

Sub SplitWbk()

    Dim strFilename As String
    Dim Cnt As Long
    
    For Cnt = 2 To Sheets.Count
        strFilename = ThisWorkbook.Path & "/" & Sheets(Cnt).Name
        Sheets(Array("Lookup", Sheets(Cnt).Name)).Copy
        ActiveWorkbook.SaveAs strFilename
        ActiveWorkbook.Close
    Next Cnt
    
End Sub

For this to work your Lookup sheet needs to be the first sheet.

 

[MariaR323]

WONDERFUL!! This worked perfectly!!

If I may add one more thing... any way to add to this and have the [lookup tab] sheet be hidden once it's in the new workbook?

MariaR323,

You might try adding the line in red...

Sub CreateNewWBS_1029835()
Dim wbThis As Workbook
Dim wbNew As Workbook
Dim ws As Worksheet
Dim strFilename As String

Set wbThis = ThisWorkbook
For Each ws In wbThis.Worksheets
    strFilename = wbThis.Path & "/" & ws.Name
    ws.Copy
    Set wbNew = ActiveWorkbook
    [COLOR=#ff0000]wbThis.Sheets("lookup").Copy before:=wbNew.Sheets(1) 'Change "lookup" to actual sheet name[/COLOR]
    wbNew.SaveAs strFilename
    wbNew.Close
Next ws
End Sub

Cheers,

tonyyy

 

[MariaR323]

Yes, indeed that is why the reasoning behind me needing the [lookup tab]. Let me try this! Thanks!

If your sheets have formulae pointing to the Lookup sheet, this might be a better way.

Sub SplitWbk()

    Dim strFilename As String
    Dim Cnt As Long
    
    For Cnt = 2 To Sheets.Count
        strFilename = ThisWorkbook.Path & "/" & Sheets(Cnt).Name
        Sheets(Array("Lookup", Sheets(Cnt).Name)).Copy
        ActiveWorkbook.SaveAs strFilename
        ActiveWorkbook.Close
    Next Cnt
    
End Sub

For this to work your Lookup sheet needs to be the first sheet.

 

[Fluff]

This will hide the lookup sheet as well

Sub SplitWbk()

    Dim strFilename As String
    Dim Cnt As Long
    
    For Cnt = 2 To Sheets.Count
        strFilename = ThisWorkbook.Path & "/" & Sheets(Cnt).Name
        Sheets(Array("Lookup", Sheets(Cnt).Name)).Copy
        Sheets("Lookup").Visible = xlHidden
        ActiveWorkbook.SaveAs strFilename
        ActiveWorkbook.Close
    Next Cnt
    
End Sub

 

[MariaR323]

Last thing I promise... can the new file be saved using the original file name and just adding the tab to it? ex. Master - Tab1, Master - Tab2

I added this and it worked to hide the lookup tab.. is there any difference?

Sheets("Bonus Table").Select
ActiveWindow.SelectedSheets.Visible = False

This will hide the lookup sheet as well

Sub SplitWbk()

    Dim strFilename As String
    Dim Cnt As Long
    
    For Cnt = 2 To Sheets.Count
        strFilename = ThisWorkbook.Path & "/" & Sheets(Cnt).Name
        Sheets(Array("Lookup", Sheets(Cnt).Name)).Copy
       [COLOR=#ff0000] Sheets("Lookup").Visible = xlHidden
        ActiveWorkbook.SaveAs strFilename[/COLOR]
        ActiveWorkbook.Close
    Next Cnt
    
End Sub

 

[Fluff]

Last thing I promise... can the new file be saved using the original file name and just adding the tab to it? ex. Master - Tab1, Master - Tab2

Try

 strFilename = ThisWorkbook.Path & "/" & Left(ThisWorkbook.Name, InStr(ThisWorkbook.Name, ".") - 1) & "-" & Sheets(Cnt).Name

as for

I added this and it worked to hide the lookup tab.. is there any difference?

Sheets("Bonus Table").Select
ActiveWindow.SelectedSheets.Visible = False

Not really, I tend not to use .select as it's not needed

 

[MariaR323]

PERFECT!! Thank you very much!! You just saved me a good amount of time

Try

 strFilename = ThisWorkbook.Path & "/" & Left(ThisWorkbook.Name, InStr(ThisWorkbook.Name, ".") - 1) & "-" & Sheets(Cnt).Name

as for
Not really, I tend not to use .select as it's not needed

 

[Fluff]

Glad to help & thanks for the feedback