Adding multiple worksheets to a new workbook based on the name of the worksheet VBA

Question

This is my first time posting here, so if my question isn't clear I apologize. I have a vba application that currently takes all visible worksheets in my workbook, and creates new workbooks for each. I need to alter this so that I can add multiple sheets to the same workbook.

ActiveWorkbook.Sheets(1).Visible = False
ActiveWorkbook.Sheets(2).Visible = False

With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
End With

Set Sourcewb = ThisWorkbook

'Create new folder to save the new files in
FolderName = Sourcewb.path & "\Tracker Workbooks"

'Copy every visible sheet to a new workbook
For Each sh In Sourcewb.Worksheets

    'If the sheet is visible then copy it to a new workbook
    If sh.Visible = -1 Then
        sh.Copy

        'Set Destwb to the new workbook
        Set Destwb = ActiveWorkbook

        'Determine the Excel version and file extension/format
        With Destwb
            If Sourcewb.Name = .Name Then
                MsgBox "Your answer is NO in the security dialog"
                GoTo GoToNextSheet
            Else
                Select Case Sourcewb.FileFormat
                Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
                Case 52:
                    If .HasVBProject Then
                        FileExtStr = ".xlsm": FileFormatNum = 52
                    Else
                        FileExtStr = ".xlsx": FileFormatNum = 51
                    End If
                Case 56: FileExtStr = ".xls": FileFormatNum = 56
                Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
                End Select
            End If
        End With

        Application.DisplayAlerts = False

        'Save the new workbook and close it
        With Destwb
            .SaveAs FolderName & "\" & Destwb.Sheets(1).Name & FileExtStr,    FileFormat:=FileFormatNum
            .Close False
        End With
        Application.DisplayAlerts = True
    End If
GoToNextSheet:
Next sh

MsgBox "You can find the files in " & FolderName

With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
End With

ActiveWorkbook.Sheets(1).Visible = True
ActiveWorkbook.Sheets(2).Visible = True
End Sub

Some of the given code was copy/pasted, but I haven't worked on this project since last summer so I'm hazy on which parts I wrote myself.

Anyways, I could have a sheet "12345" which I would make a new workbook for and copy the sheet to that workbook, then name the workbook "12345". If I have sheets "54321-1" and "54321-2", I need both of them to copy to the same workbook named "54321" with 2 tabs of sheets named "54321-1" and "54321-2". Currently, it will make 2 separate workbooks: "54321-1" and "54321-2". Sorry if this is an obvious answer.

Thank you kindly,

Jimmy

Máté Juhász Máté Juhász · Accepted Answer · 2015-05-05T09:13:44

In Copy method you can specify where you want to copy your sheet, otherwise it will be placed in a new workbook, that's the case in your current code. Just change the code to something like: sh.copy after:=destwb.sheets(1) (note: it'll work only after you've already set destwb, so copy the first sheet as you do it now).

Adding multiple worksheets to a new workbook based on the name of the worksheet VBA

1 Answers