Option Explicit
Sub Выгрузка()
    Dim myFiltered As Range 'отфильтрованный диапазон
    Dim MyCol As Object 'столбец с нашими значениями с автофильтром
    Dim iCrit$ 'критерий отбора
    Dim iLastRow&, i&, i2 As Long
    Dim iPath$
    Dim fil As Filter
    Dim tmp() As String, fl As Boolean
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    On Error GoTo ErrHandler
    ActiveSheet.Cells.UnMerge
    If ActiveSheet.AutoFilterMode Then
        For Each fil In ActiveSheet.AutoFilter.Filters
            If fil.On Then ActiveSheet.ShowAllData: Exit For
        Next
    Else
        ActiveSheet.Range(ActiveSheet.Cells( 2 ,  1 ), ActiveSheet.Cells( 2 , ActiveSheet.UsedRange.Columns.Count +  1 )).AutoFilter '
    End If
    iLastRow = ActiveSheet.Cells(Rows.Count,  1 ).End(xlUp).Row
    ReDim tmp( 0 )
    iPath = "C:\Temp\" 'путь, куда будем сохранять файлы
    For i =  3  To iLastRow
        iCrit = ActiveSheet.Cells(i,  1 )
        fl = False
        For i2 =  0  To UBound(tmp)
            If iCrit = tmp(i2) Then fl = True
        Next
        If Not fl Then
            If tmp( 0 ) <> "" Then ReDim Preserve tmp(UBound(tmp) +  1 )
            tmp(UBound(tmp)) = iCrit
            ActiveSheet.Cells( 1 ,  1 ).AutoFilter field:= 1 , Criteria1:=iCrit
            Set myFiltered = ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible)
            myFiltered.Copy
            Workbooks.Add
            ActiveSheet.Paste
            Application.CutCopyMode = False
            ActiveWorkbook.SaveAs Filename:=iPath & iCrit & ".xls"
            ActiveWorkbook.Close True 'закрыть книгу сохранив изменения
        End If
    Next i
    ActiveSheet.ShowAllData
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    MsgBox "Выгрузка завершена!" & vbCrLf & "Файлы сохранены в папке: " & iPath, vbInformation, "Конец"
    Exit Sub
ErrHandler:
    MsgBox "При выполнении макроса произошла ошибка!" & vbCrLf & "Описание: " & Err.Description & vbCrLf & "Номер: " & Err.Number, vbExclamation, "Ошибка"
End Sub