VBA to Split Worksheets into separate Workbooks by Tab Name

I have a workbook that has the following tabs:
Assignments_CENTRL
Assignments_NORTHR
Assignments_PACIFC
Assignments_SOUTHD
Assignments_SOUTHJ
SummaryAuditRptCENTRL
SummaryAuditRptNORTHR
SummaryAuditRptPACIFC
SummaryAuditRptSOUTHD
SummaryAuditRptSOUTHJ
SummaryRptCENTRL
SummaryRptNORTHR
SummaryRptPACIFC
SummaryRptSOUTHD
SummaryRptSOUTHJ


And I need them broken into separate workbooks by the last 6 for the tab name:
File: CENTRL_CCYYMMDD
TabNames: Assignments_CENTRL; SummaryAuditRptCENTRL; SummaryRptCENTRL

File: NORTHR_CCYYMMDD
Tab Names: Assignments_NORTHR, SummaryAuditRptNORTHR, SummaryRptNORTHR
etc
then possibly drop the last 6 of the tab names:
File: CENTRL_CCYYMMDD
TabNames: Assignments; SummaryAuditRpt; SummaryRpt

This is the code i have so far:

Sub Bridge_Optimizer6_Workbook_Creator()
Dim SFilename As String
Dim SPath As String
Dim str, RegResult, TrimResult As String
Dim RegionWB As Workbook
Dim SOptimizerWB As Workbook
Dim WSouter, WSinner As Worksheet
Dim SOptimizerWS As String

Set SOptimizerWB = ActiveWorkbook
SOptWBCount = SOptimizerWB.Worksheets.Count

For Each WSouter In SOptimizerWB.Sheets
    SOptimizerWS = WSouter.Name
    str = SOptimizerWS
    RegResult = Right(str, 6)
    TrimResult = Right(SOptimizerWB.Name, 20)
    SFilename = RegResult & "_" & TrimResult
    SPath = SOptimizerWB.Path
    Set RegionWB = Workbooks.Add

RegionWB.SaveAs SPath & "\" & SFilename

For Each WSinner In SOptimizerWB.Sheets
If Right(WSinner.Name, 6) = RegResult Then
    WSinner.Move After:=RegionWB.Sheets(RegionWB.Sheets.Count)
End If
Next WSinner

Next WSouter
End Sub

But I dont want a Sheet1 in each
And our company is using Titus classification and it stops at Each file to ask classification