You have a number of assumptions about WS names, etc.
Option Explicit
Sub SplitWorkbook()
Dim sNames As String, sName As String
Dim ws As Worksheet
Dim aryNames As Variant
Dim wbName As Workbook
Dim iName As Long
Application.ScreenUpdating = False
'build string of WS names that do NOT end with a )
For Each ws In Worksheets
If Right(ws.Name, 1) <> ")" Then
sNames = sNames & ws.Name & ";"
End If
Next
If Right(sNames, 1) = ";" Then sNames = Left(sNames, Len(sNames) - 1)
'put WS base names into array
aryNames = Split(sNames, ";")
For i = LBound(aryNames) To UBound(aryNames)
'copy base WS to make new WB
Worksheets(aryNames(i)).Copy
Set wbName = ActiveWorkbook
'add the (2) and (3) WS to new WB
ThisWorkbook.Worksheets(aryNames(i) & " (2)").Copy After:=wbName.Sheets(1)
ThisWorkbook.Worksheets(aryNames(i) & " (3)").Copy After:=wbName.Sheets(2)
'build the new WB name = this path + base name
sName = ThisWorkbook.Path & Application.PathSeparator & aryNames(i) & ".xlsx"
'delete if it exists
Application.DisplayAlerts = False
On Error Resume Next
Kill sName
On Error GoTo 0
Application.DisplayAlerts = True
'save new WB and close
wbName.SaveAs Filename:=ThisWorkbook.Path & Application.PathSeparator & aryNames(i) & ".xlsx", FileFormat:=xlOpenXMLWorkbook
ActiveWindow.Close
Next i
Application.ScreenUpdating = True
MsgBox "Done"
End Sub
My crystal ball tells me the next thing will be VBA to email each WB to the designated person