Filter and Save as new workbooks

Try this

Option Explicit

'---------------------------------------------------------------------------------------
' Module    : Module1
' DateTime  : 24/09/2006 22:48
'           : 30/06/2011 adapted to copy sheets to individual workbooks
' Author    : Roy Cox (royUK)
' Website   :  more examples
' Purpose   :  Create a sheet for each unique name in data & move to new workbook
' Disclaimer; This code is offered as is with no guarantees. You may use it in your
'             projects but please leave this header intact.
'---------------------------------------------------------------------------------------

Sub ExtractToSheets()
    Dim ws As Worksheet
    Dim wsNew As Worksheet
    Dim rData As Range
    Dim rCl As Range
    Dim sNm As String
    Set ws = Sheet1

    'extract a list of unique names
    'first clear existing list
    With ws
        Set rData = .Cells(1, 1).CurrentRegion
        .Columns(.Columns.Count).Clear
        rData.Columns(1).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Cells(1, .Columns.Count), Unique:=True

        For Each rCl In .Range(.Cells(2, .Columns.Count), .Cells(.Rows.Count, .Columns.Count).End(xlUp))
            sNm = rCl.Text
            'add new sheet (only if required-NB uses UDF)
            Set wsNew = Sheets.Add
            wsNew.Name = sNm
            'AutoFilter & copy to relevant sheet
            rData.AutoFilter Field:=1, Criteria1:=sNm
            rData.Copy Destination:=Worksheets(sNm).Cells(1, 1)
            Sheets(sNm).Copy    'create new workbook
            ActiveWorkbook.SaveAs ThisWorkbook.Path & Application.PathSeparator & sNm & ".xlsx"
            ActiveWorkbook.Close
            Application.DisplayAlerts = False
            Sheets(sNm).Delete    'create new workbook
            Application.DisplayAlerts = True
        Next rCl
    End With
    ws.Columns(Columns.Count).ClearContents        'remove temporary list
    rData.AutoFilter        'switch off AutoFilter
End Sub

If you are satisfied with the solution(s) provided, please mark your thread as Solved.

How to mark a thread Solved
Go to the first post
Click edit
Click Go Advanced
Just below the word Title you will see a dropdown with the word No prefix.
Change to Solved
Click Save