OK -- try this
Option Explicit
Sub SplitWorkbook()
Dim sDate As String, sPrefix As String
Dim wb1 As Workbook, wb2 As Workbook
Dim sPath1 As String, sFile2 As String
Dim i As Long
Dim aSheetsToCopy As Variant, v As Variant
'get default prefix -- Previous month + Year
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
'see if the user wants to change it
sPrefix = Application.InputBox("Enter the Prefix for the created workbooks, (blank) to exit", "Split Workbook", sDate, , , , , 2)
'trim and if len = 0 then exit sub
sPrefix = Trim(sPrefix)
If Len(sPrefix) = 0 Then Exit Sub
Application.ScreenUpdating = False
'build list of sheets to extract
aSheetsToCopy = Array("MAINTENANCE", "PRODUCTION", "PURCHASING", "QC", "SALES", "SHOWROOM", "WAREHOUSE", "COLD STORAGE", "FINANCE", "HR", "LADIES")
'remember this workbook and path so we don't get confused
Set wb1 = ThisWorkbook
sPath1 = wb1.Path & Application.PathSeparator
For Each v In aSheetsToCopy
'make sure the sheet exists
i = -1
On Error Resume Next
i = wb1.Worksheets(v).Index
On Error GoTo 0
If i = -1 Then
Call MsgBox("Worksheet " & v & " does not exist", vbCritical + vbOKOnly, "Split Workbook")
Else
Application.StatusBar = "Copying " & v
sFile2 = sPrefix & " " & v
Worksheets(v).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
End If
Next
Application.StatusBar = False
Application.ScreenUpdating = True
Call MsgBox("Worksheets have been copied to seperate workbooks", vbInformation + vbOKOnly, "Split Workbook")
End Sub