Use a Loop to Copy Certain Sets of Sheets to New Workbooks

So here's my brain-killer:

I need to save a Glossary tab with each of my worksheets (Plant Code Tabs) in this workbook to send out files to managers. I have the code that creates the individual Plant Code files and saves them to my desktop, using the plant codes for the new workbook name. Can anyone give me a hand here with adding a segment to my loop to add the glossary tab to my new workbooks?

Also, can I use an "else" to only create specific files if I don't want files of every single tab? I'm new to VBA, and haven't really figured out how to declare and specify details with loops yet. Thank you!

Code:

---

Sub SaveShtsAsBook()
    Dim Sheet As Worksheet, SheetName$, MyFilePath$, N&
    MyFilePath$ = ActiveWorkbook.Path & "\" & _
    Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4)
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        '      End With
        On Error Resume Next '<< a folder exists
        MkDir MyFilePath '<< create a folder
        For N = 1 To Sheets.Count
            Sheets(N).Activate
            SheetName = ActiveSheet.Name
            Sheets(Array("ActiveSheet", "Glossary of Terms")).Copy
            Workbooks.Add (xlWBATWorksheet)
            With ActiveWorkbook
                With .ActiveSheet
                    .Paste
                    .Name = SheetName
                    [A1].Select
                End With
                'save book in this folder
                .SaveAs Filename:=MyFilePath _
                & "\" & SheetName & ".xlsx"
                .Close savechanges:=True
            End With
            .CutCopyMode = False
        Next
    End With
    Sheet1.Activate
End Sub

---

https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA

Can you please rephrase that a bit. I am not able to figure out what exactly are you trying to get done

Excel Fox, thank you for the quick response! I'll back up a bit; my workbook has a summary tab with all of my data in it. The data is filtered by plant code (ex. BG, CW), and then pasted on a tab labeled "BG" or "CW." I am trying to save two sheets together in a new workbook: a Glossary/Instructions type tab, and the corresponding plant code tab (BG). I want the sheet to be named after the plant code, as it currently is, but have both sheets instead of just the plant code sheet (individual tab).

Now: BG.xlsx is saved with only one tab, the BG filtered data
Need: BG.xlsx saved with two tabs, the BG filtered data, as well as the Glossary tab.

In summary, the code above loops through my workbook and creates separate workbooks for every single tab, saving them in a destination folder. I want to include the other tab "Glossary" in with these single workbooks as well. How doable is that?

Pretty doable. And this glossary tab should be empty? Cause I don't see you mentioning anywhere what the glossary tab will contain.

Try this

Code:

---

Sub SaveShtsAsBook()
    Dim Sheet As Worksheet, SheetName$, MyFilePath$, N&
    MyFilePath$ = ActiveWorkbook.Path & "\" & _
    Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 4)
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        '      End With
        On Error Resume Next '<< a folder exists
        MkDir MyFilePath '<< create a folder
        For N = 1 To Sheets.Count
            Sheets(N).Activate
            SheetName = ActiveSheet.Name
            Sheets(Array("ActiveSheet", "Glossary of Terms")).Copy
            Workbooks.Add (xlWBATWorksheet)
            With ActiveWorkbook
                With .ActiveSheet
                    .Paste
                    .Name = SheetName
                    [A1].Select
                End With
                .Worksheets.Add After:=.Worksheets(1)
                .Worksheets(2).Name = "Glossary"
                'save book in this folder
                .SaveAs Filename:=MyFilePath _
                & "\" & SheetName & ".xlsx"
                .Close savechanges:=True
            End With
            .CutCopyMode = False
        Next
    End With
    Sheet1.Activate
End Sub

---