Private Sub AutoFilterSave()
    Set iList = ActiveSheet 'Можно указать вполне конкретный лист
    If iList.AutoFilter Is Nothing Then
       MsgBox "Aвтофильтр отсутствует", vbCritical, iList.Name
       Exit Sub
    End If
    
    With iList.AutoFilter.Filters
         ReDim iArr(1 To .Count, 1 To 3)
         For iColumn = 1 To .Count
             With .Item(iColumn)
                  If .On = True Then
                     iArr(iColumn, 1) = .Criteria1
                     If .Operator = xlOr Then
                        iArr(iColumn, 2) = .Operator
                        iArr(iColumn, 3) = .Criteria2
                     End If
                  End If
             End With
         Next
         iAddress = .Parent.Range.Address
    End With
End Sub
    
Private Sub AutoFilterApply()
    If iAddress = "" Then
       MsgBox "Восстановление невозможно ...", vbCritical, ""
       Exit Sub
    End If

    Dim iSource As Range: Set iSource = iList.Range(iAddress)

    For iColumn = 1 To UBound(iArr)
        If Not IsEmpty(iArr(iColumn, 1)) Then
           If iArr(iColumn, 2) = xlOr Then
              iSource.AutoFilter iColumn, _
              iArr(iColumn, 1), iArr(iColumn, 2), iArr(iColumn, 3)
           Else
              iSource.AutoFilter iColumn, iArr(iColumn, 1)
           End If
        Else
           iSource.AutoFilter iColumn
        End If
    Next
End Sub

Нашел на просторах интернета, но не работает в моем примере.