Split 1 Workbook With Worksheet Tab For Each Dept Into Individual Workbooks

[Bob R]

SUMMARY:
Is there a method (simple?) to copy the 30-40 individual worksheet tabs from 1 Excel workbook to individual workbooks? 1 workbook for each tab in main workbook.

DETAILS:
My main workbook has a pivot table with a Department filter. I then used Pivot Table Tools > Analyze > Options > Show Report Filter Pages to create individual worksheets for each department's data.

Now need to place each department's report into a separate workbook.

Thanks,
Bob

 

[Logit]

Saves each sheet as an .XLSX file in the same location as the main workbook :

Option Explicit

Sub SplitWorkbook()
    Dim sDate As String
    Dim ws As Worksheet
    Dim wb1 As Workbook, wb2 As Workbook
    Dim sPath1 As String, sFile2 As String
    
    Application.ScreenUpdating = False
    
    Set wb1 = ThisWorkbook
    
    If Month(Now) - 1 = 0 Then
        sDate = Format(DateSerial(Year(Now) - 1, 12, 1), "mmmm yyyy")
    Else
        sDate = Format(DateSerial(Year(Now), Month(Now) - 1, 1), "mmmm yyyy")
    End If
        
        
    sPath1 = wb1.Path & Application.PathSeparator
        
    For Each ws In wb1.Worksheets
        sFile2 = sDate & " " & ws.Name
        ws.Copy
        Set wb2 = ActiveWorkbook
        
        On Error Resume Next
        Kill sPath1 & sFile2 & ".xlsx"
        On Error GoTo 0
        
        wb2.SaveAs Filename:=sPath1 & sFile2, FileFormat:=xlOpenXMLWorkbook
    
        wb2.Close (False)
    
        wb1.Activate
    
    Next

    Application.ScreenUpdating = True

End Sub

 

[Bob R]

Many thanks.