Splitting a workbook into multiple files AND adding a specific worksheet to each

[benparmer]

I am currently using the following procedure to take a spreadsheet with multiple worksheets to create and save each worksheet into separate files based on the worksheet names.

Sub Splitbook()
'Updateby20140612
Dim xPath As String
xPath = Application.ActiveWorkbook.Path
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each xWs In ThisWorkbook.Sheets
    xWs.Copy
    ActiveSheet.Protect 
    Application.ActiveWorkbook.SaveAs Filename:=xPath & "\" & xWs.Name & ".xlsx"
    Application.ActiveWorkbook.Close False
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

This works as expect but now I also need to add one unique worksheet to each workbook that is created through the process above, we'll call it "procedures", so that each saved worksheet has a second worksheet called procedures. I am stumped how to alter this process to add in that worksheet to each file. Alternatively, I am ok with a process to take this worksheet and add it to ALL files in a given folder. I have tried the process below with no luck as I get a vba/macro enabled save error on EACH file that opens to select yes or no, this is not something I wish to do as there are 100+ files, it needs to be automated. THANKS

Copy Worksheet from master file to multiple files in a folder with VBA

Hi, hoping someone can help me with this. I have a workbook called Rules which contains one worksheet also called Rules. I would like to take a mirror of this worksheet in its entirety and move a copy to all the excel files in a destination folder that I specify. I am using a third file as a...

www.mrexcel.com

 

[benparmer]

This?

Sub Splitbook()
'Updateby20140612
    Dim xPath As String, xWs As Worksheet
    xPath = Application.ActiveWorkbook.Path
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    For Each xWs In ThisWorkbook.Sheets
        xWs.Copy
        With ActiveWorkbook
            ActiveSheet.Name = "data"
            .Worksheets.Add after:=Worksheets(1)
            ActiveSheet.Name = "procedures"
            ActiveSheet.Previous.Protect
        End With
        Application.ActiveWorkbook.SaveAs Filename:=xPath & "\" & xWs.Name & ".xlsx"
        Application.ActiveWorkbook.Close False
    Next
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

I ran into a problem again with the process above, my "procedures" tab isn't getting copied over from the source file to the individual sheets with the data in it that is in the source sheet. It's like it is just creating a worksheet called "procedures" in the new workbooks but not copying over data. That is the last piece I need to work.

 

[igold]

I did not understand your request. I thought that the added "procedures" worksheet was supposed to be a blank sheet. Can you explain where in your source workbook that the "procedures" worksheet is supposed to be getting its contents from. I thought that all the worksheets in the source workbook were the sheets that were getting re-named as data in the new workbooks.

 

[benparmer]

I did not understand your request. I thought that the added "procedures" worksheet was supposed to be a blank sheet. Can you explain where in your source workbook that the "procedures" worksheet is supposed to be getting its contents from. I thought that all the worksheets in the source workbook were the sheets that were getting re-named as data in the new workbooks.

Yeah I realized I may not have been clear. Hopefully this example explains things:

Worksheets within the workbook (these all have the data in them I want to be contained in the newly created files):

Sheet1-contains data
Sheet2-contains data
Sheet3-contains data
Procedures-contains data

I run the VBA and end up with 4 files, all 4 files are named based on the original sheet names and they contain the data from the original sheet in the original source file, this part works as expected. Each workbook also has a Procedures worksheet but it is blank, it didn't get copied over with data.

Essentially I want for every workbook that is created add a worksheet to it with the Procedures tab with the data it had in the source document.

 

[igold]

Just to be clear... Each newly created workbook is going to have a unique "data" sheet and a "procedure" sheet that is identical to the single "procedure" sheet in the source workbook. Also the 'procedure" does not get its own newly created workbook.
Also, can you give me an idea of what the data in the procedure sheet looks like. Are there any formulas or is it just data and where in the procedure sheet does the data reside. Does it start in Cell A1. Is it possible to show a representative sample of what the 'procedure" looks like.

 

[benparmer]

Just to be clear... Each newly created workbook is going to have a unique "data" sheet and a "procedure" sheet that is identical to the single "procedure" sheet in the source workbook. Also the 'procedure" does not get its own newly created workbook.
Also, can you give me an idea of what the data in the procedure sheet looks like. Are there any formulas or is it just data and where in the procedure sheet does the data reside. Does it start in Cell A1. Is it possible to show a representative sample of what the 'procedure" looks like.

Yes you are correct,

Each newly created workbook is going to have a unique "data" sheet and a "procedure" sheet that is identical to the single "procedure" sheet in the source workbook.

And I really don't care if the Procedure get it's on newly created document, so I don't want to get hung up on that, I can delete it after the fact.


"Procedure" worksheet is just text in a few cells and columns.
"Data" worksheets are 1 header row and one row of data, 3 columns in all.

Thanks again!

 

[igold]

Is this getting close. I did not know where to paste the data for the "procedure" sheet, so I put it starting in Cell A1. Also for sake of ease I am letting the code create the workbook for the "procedure" sheet, which you indicated you would just delete.

Sub Splitbook()
'Updateby20140612
    Dim xPath As String, xWs As Worksheet, wb As Workbook
    xPath = Application.ActiveWorkbook.Path
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set wb = ThisWorkbook
    For Each xWs In ThisWorkbook.Sheets
        xWs.Copy
        With ActiveWorkbook
            ActiveSheet.Name = "data"
            .Worksheets.Add after:=Worksheets(1)
            ActiveSheet.Name = "procedure"
            wb.Worksheets("procedure").UsedRange.Copy
            ActiveSheet.Range("A1").PasteSpecial xlPasteAll
            ActiveSheet.Previous.Protect
        End With
        Application.ActiveWorkbook.SaveAs Filename:=xPath & "\" & xWs.Name & ".xlsx"
        Application.ActiveWorkbook.Close False
    Next
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

 

[benparmer]

Yes! This is perfect. Thanks again

 

[igold]

Great, I am glad that it is squared away.

If a post in this thread solved your question, please consider marking it as solution. Please see Mark as Solution