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

MariaR323

New Member
Joined
Sep 13, 2017
Messages
12
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
 

Excel Facts

How to create a cell-sized chart?
Tiny charts, called Sparklines, were added to Excel 2010. Look for Sparklines on the Insert tab.
MariaR323,

You might try adding the line in red...

Code:
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
 
Upvote 0
If your sheets have formulae pointing to the Lookup sheet, this might be a better way.
Code:
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.
 
Upvote 0
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...

Code:
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
 
Upvote 0
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.
Code:
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.
 
Upvote 0
This will hide the lookup sheet as well
Code:
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
 
Upvote 0
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
Code:
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
 
Upvote 0
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

Code:
 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
 
Upvote 0
PERFECT!! Thank you very much!! You just saved me a good amount of time :)

Try

Code:
 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
 
Upvote 0
Glad to help & thanks for the feedback
 
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