AutoFilter With FSO

Sub job()
Application.ScreenUpdating = False
Dim i As Integer
Dim Ccount As Integer
Dim j As String
Dim sh As Worksheet
Dim RowCount As Integer
RowCount = Cells(Rows.Count, "a").End(xlUp).Row

Set sh = Sheets(1)
sh.Range("a1 : A" & RowCount).Copy Destination:=sh.Range("k1")
Range("k1").CurrentRegion.RemoveDuplicates Columns:=1, Header:=xlYes
Ccount = Cells(Rows.Count, "k").End(xlUp).Row
    For i = 2 To Ccount
        j = Range("k" & i).Value
        Range("A1").AutoFilter field:=1, Criteria1:=j
        ThisWorkbook.Sheets.Add after:=Sheets(Sheets.Count)
        ActiveSheet.Name = j
        sh.Range("A1").CurrentRegion.Copy Destination:=ActiveSheet.Range("A1")
        sh.Activate
        Selection.AutoFilter
    Next i
Range("k1").CurrentRegion.Clear
MsgBox "Done.....Please Check worksheets", vbOKOnly, "Vikas Verma"
Workbooks("Autofilter").Save
Application.DisplayAlerts = False

End Sub

Workbook