Public Sub www()
    Application.ScreenUpdating = False
    Dim i&, a, sh As Worksheet
    a = [a1].CurrentRegion
    With CreateObject("scripting.dictionary")
        For i = 2 To UBound(a): .Item(a(i, 1)) = "": Next
        a = .keys
    End With
    For i = 0 To UBound(a)
        ThisWorkbook.Sheets.Copy
        For Each sh In ActiveWorkbook.Sheets
            n = sh.Cells.Find(what:="столбец_уникальный", LookAt:=xlWhole).Column
            With sh.[a1].CurrentRegion
                .AutoFilter n, "<>" & a(i)
                .Offset(1).SpecialCells(12).EntireRow.Delete
                sh.AutoFilterMode = 0
            End With
        Next sh
        With ActiveWorkbook
            .SaveAs ThisWorkbook.Path & "\" & a(i) & ".xlsx", 51
            .Close
        End With
    Next
    Application.ScreenUpdating = True
End Sub

Public Sub www()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = 0 '===чтобы не спрашивал при переписывании файла
    Dim i&, a, sh As Worksheet, n '===добавил объявление n на случай Option Explicit
    a = [a1].CurrentRegion
    With CreateObject("scripting.dictionary")
        For i = 2 To UBound(a): .Item(a(i, 1)) = "": Next
        a = .keys
    End With
    For i = 0 To UBound(a)
        ThisWorkbook.Sheets.Copy
        For Each sh In ActiveWorkbook.Sheets
            n = sh.Cells.Find(what:="ID_VUZ", LookAt:=xlWhole).Column '===поменял название столбца для проверки
            With sh.[a1].CurrentRegion
                If sh.AutoFilterMode Then '===если автофильтр на листе есть
                    .AutoFilter '===снимаем его
                End If '===
                .AutoFilter n, "<>" & a(i)
                .Offset(1).SpecialCells(12).EntireRow.Delete
                sh.AutoFilterMode = 0
            End With
        Next sh
        With ActiveWorkbook
            .SaveAs ThisWorkbook.Path & "\" & a(i) & ".xlsx", 51
            .Close
        End With
    Next
    Application.DisplayAlerts = 1 '===
    Application.ScreenUpdating = True
End Sub