Option Explicit
Sub Split_Multiple_Sheets_in_A_Workbook()
Dim MySheet As Worksheet, ws As Worksheet
Dim MyRange As Range, i As Long, N As Workbook
Dim UList As Collection, UListValue As Variant, c as long
Application.ScreenUpdating = False
c = Application.InputBox("Pls Enter Column No like as 1 for A,2 for B", "Column to filter", , , , , , 1)
Set MySheet = ActiveSheet
If MySheet.AutoFilterMode = False Then Exit Sub
Set MyRange = Range(MySheet.AutoFilter.Range.Columns(c).Address)
Set UList = New Collection
On Error Resume Next
For i = 2 To MyRange.Rows.Count
UList.Add MyRange.Cells(i, 1), CStr(MyRange.Cells(i, 1))
Next i
On Error GoTo 0
For Each UListValue In UList
Set N = Workbooks.Add(xlWBATWorksheet)
For Each ws In ThisWorkbook.Sheets
ws.UsedRange.AutoFilter c, UListValue
'ws.Range(ws.AutoFilter.Range.Address).AutoFilter c, UListValue
With N
ws.AutoFilter.Range.Copy
Sheets.Add().Name = ws.Name
Sheets(ws.Name).Paste
Cells.EntireColumn.AutoFit
End With
Next ws
N.SaveAs Filename:=Application.ThisWorkbook.Path & "\" & AlphaNumericOnly(UListValue.Value) ', FileFormat:=xlExcel12 _
, CreateBackup:=False
N.Close False
Next UListValue
MySheet.AutoFilter.ShowAllData
MySheet.Select
Application.ScreenUpdating = True
End Sub