With ThisWorkbook.Worksheets(1) 'Workbooks(...)
     If .AutoFilterMode = True And .FilterMode = True Then
        With .AutoFilter.Range
             iCountOfRows = .Columns(1).SpecialCells(xlVisible).Cells.Count
             'iCountOfRows = .Columns(1).Rows.SpecialCells(xlVisible).Count
             MsgBox "Количество отфильтрованных строк " & iCountOfRows - 1
        End With
     End If
End With

With ThisWorkbook.Worksheets(1)
     If .AutoFilterMode = True Then
        For Each iCell In .AutoFilter.Range.Columns(1).Cells '.Rows
            MsgBox iCell.Value
        Next
     End If
End With

With ThisWorkbook.Worksheets(1)
     If .AutoFilterMode = True And .FilterMode = True Then
        With .AutoFilter.Range.Columns(1)
             Set iFilterRange = _
             .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlVisible)
             For Each iCell In iFilterRange
                 MsgBox iCell.Value
             Next
        End With
        .ShowAllData 'Отобразить всё - необязательно
     End If
End With

Private Function IsFilter() As Boolean
'***************************************************'
'   Автор Климов Павел Юрьевич                      '
'   http://www.msoffice.nm.ru                       '
'***************************************************'
     Dim iCell As Range
     Set iCell = Application.Caller
     With iCell.Worksheet
          If .AutoFilterMode = True Then
             With .AutoFilter
                  For iColumn% = 1 To .Filters.Count
                      If Not Intersect(iCell, .Range. _
                         Columns(iColumn%)) Is Nothing Then
                         IsFilter = .Filters(iColumn%).On '
                         Exit Function
                      End If
                  Next
             End With
          End If
     End With
End Function

Private Function IsFilter(iCell As Range) As Boolean
'***************************************************'
'   Автор Климов Павел Юрьевич                      '
'   http://www.msoffice.nm.ru                       '
'***************************************************'
     With iCell.Parent
          If .AutoFilterMode = True Then
             Dim iCellFilter As Range
             For Each iCellFilter In .AutoFilter.Range.Rows(1).Cells
                 iColumn% = iColumn% + 1
                 If iCellFilter.Address = iCell.Address Then
                    IsFilter = .AutoFilter.Filters(iColumn%).On
                    Exit Function
                 End If
             Next
         End If
     End With
End Function

Private Function GetCriteria$()
'***************************************************'
'   Автор Климов Павел Юрьевич                      '
'   http://www.msoffice.nm.ru                       '
'***************************************************'
     Application.Volatile True
     Dim iCell As Range, iFilterColumn As Range
     Set iCell = Application.Caller
     With iCell.Worksheet
          If Not .AutoFilterMode Or Not .FilterMode Then
             'Здесь можно вывести отчёт о состоянии автофильтра
             Exit Function
          End If
          For Each iFilterColumn In .AutoFilter.Range.Columns
              iColumn% = iColumn% + 1
              If Not Intersect(iFilterColumn, _
                 iCell.EntireColumn) Is Nothing Then
                 With .AutoFilter.Filters(iColumn%) '
                      If Not .On Then Exit Function '
                      GetCriteria$ = .Criteria1
                      If .Operator = xlAnd Then
                         GetCriteria$ = GetCriteria$ & " И " & .Criteria2
                      ElseIf .Operator = xlOr Then
                         GetCriteria$ = GetCriteria$ & " ИЛИ " & .Criteria2
                      End If
                      Exit Function
                 End With
              End If
          Next
     End With
End Function

Private Sub CheckBox_Filter()
    If Not Me.ProtectContents Then
       With Me.CheckBoxes(Application.Caller)
            With .TopLeftCell
                 iField& = .Column
                 iCriteria$ = .EntireColumn.Cells(1).Text
            End With
            If .Value = xlOff Then
               Me.Range("DataBase").AutoFilter Field:=iField&
            Else
               Me.Range("DataBase").AutoFilter _
               Field:=iField&, Criteria1:=iCriteria$
            End If
        End With
    Else
       MsgBox "Рабочий лист защищён", vbExclamation, ""
    End If
End Sub

Private Sub HiddenAllDropDowns()
    Dim iShape As Shape
    For Each iShape In Worksheets(1).Shapes
        If iShape.Type = msoFormControl Then
           If iShape.FormControlType = _
           xlDropDown Then iShape.Visible = msoFalse
        End If
    Next
End Sub

Private Sub AutoFilterHiddenDropDowns()
    Dim iAutoFilter As AutoFilter, iFilter As Filter, iDiapazon As Range
    
    If Лист1.AutoFilterMode = True Then
       Set iAutoFilter = Лист1.AutoFilter
       Set iDiapazon = iAutoFilter.Range
       For Each iFilter In iAutoFilter.Filters
           iColumn% = iColumn% + 1
           With iFilter
                If .On = True Then
                   If .Operator = xlAnd Or .Operator = xlOr Then
                      iDiapazon.AutoFilter _
                      iColumn%, .Criteria1, .Operator, .Criteria2, False
                   Else
                      iDiapazon.AutoFilter iColumn%, .Criteria1, , , False
                   End If
                Else
                   iDiapazon.AutoFilter iColumn%, , , , False
                End If
           End With
       Next
    End If
End Sub

Private Sub AutoFilterHiddenDropDowns2()
    Dim iDiapazon As Range, iFilters As Filters
    Dim iAutoFilter As AutoFilter, iColumn%
    Set iAutoFilter = Лист1.AutoFilter
    
    If Not iAutoFilter Is Nothing Then
       Set iFilters = iAutoFilter.Filters
       Set iDiapazon = iAutoFilter.Range
       For iColumn = 1 To iFilters.Count
           With iFilters(iColumn)
                If .On = True Then
                   If .Operator = xlAnd Or .Operator = xlOr Then
                      iDiapazon.AutoFilter Field:=iColumn, _
                      Criteria1:=.Criteria1, Operator:=.Operator, _
                      Criteria2:=.Criteria2, VisibleDropDown:=False
                   Else
                      iDiapazon.AutoFilter Field:=iColumn, _
                      Criteria1:=.Criteria1, VisibleDropDown:=False
                   End If
                Else
                   iDiapazon.AutoFilter Field:=iColumn, VisibleDropDown:=False
                End If
           End With
       Next
    End If
End Sub

Private Sub ShowAutoFilterFalse()
    Лист1.AutoFilterMode = False
    Dim iListObject As ListObject
    For Each iListObject In Лист1.ListObjects
        iListObject.ShowAutoFilter = False
    Next
End Sub

Private Sub ShowAutoFilterFalse2()
    With Worksheets(1) 'Worksheets("Отчёт")
         .AutoFilterMode = False
         Dim iListObject As ListObject
         For Each iListObject In .ListObjects
             iListObject.ShowAutoFilter = False
         Next
    End With
End Sub

Private iList As Worksheet
Private iAddress$, iColumn%, iArr() As Variant

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

Private Sub AutoFilterApply2()
    If iAddress = "" Then
       MsgBox "Восстановление невозможно ...", vbCritical, ""
       Exit Sub
    End If
   
    If iList.FilterMode = True Then iList.ShowAllData 'iList.FilterMode = False

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

Private Sub AutoFilter_ChangeMonth()
    Dim iMonth%: iMonth = 2 'Укажите свой месяц
    
    Range("A:A").AutoFilter Field:=1, Criteria1:=iMonth + 20, Operator:=xlFilterDynamic
End Sub

Private Sub AutoFilter_LikeText()
    Dim iAddress$, iText$, iCriteria1(), iCriteria2()
    Dim iSource As Range, iCell As Range, iCount1&, iCount2&
    
    Set iSource = Range("A:A") '[A:A]
    iCriteria1 = Array("Иванов", "Петров", "Сидоров")
    
    For iCount1 = 0 To UBound(iCriteria1)
        iText = iCriteria1(iCount1)
        Set iCell = iSource.Find(iText, , xlValues, xlPart)
        'Set iCell = iSource.Find("*" & iText & "*", , xlValues, xlWhole)
        If Not iCell Is Nothing Then
           iAddress = iCell.Address
           Do
                ReDim Preserve iCriteria2(iCount2)
                iCriteria2(iCount2) = iCell.Value
                iCount2 = iCount2 + 1
                Set iCell = iSource.FindNext(iCell)
           Loop While iAddress <> iCell.Address
        End If
    Next
    
    If iCount2 > 0 Then
       iSource.AutoFilter 1, iCriteria2, xlFilterValues
    Else
       MsgBox Join(iCriteria1, vbCrLf), , "Ничего не найдено"
    End If
End Sub

iCriteria1 = Array("Иванов*", "*ин", "Р?занов")

Set iCell = iSource.Find(iText, , xlValues, xlWhole)