Filtre automatique

Sub InverserFiltrage()
Dim col%, d As Object, i&, crit
col = 1 'colonne de filtrage, à adapter
Set d = CreateObject("Scripting.Dictionary")
With [A1].CurrentRegion 'à adapter
  For i = 2 To .Rows.Count
    If .Rows(i).Hidden Then d(.Cells(i, col).Value) = ""
  Next
  If d.Count Then crit = d.keys Else crit = "="
  .AutoFilter col, crit, xlFilterValues
End With
End Sub

Sub InverserFiltrage()
Dim col%, d As Object, i&, crit
col = 1 'colonne de filtrage, à adapter
Set d = CreateObject("Scripting.Dictionary")
With [A1].CurrentRegion 'à adapter
  For i = 2 To .Rows.Count
    If .Rows(i).Hidden Then d(.Cells(i, col).Text) = ""
  Next
  If d.Count Then crit = d.keys Else crit = "="
  .AutoFilter col, crit, xlFilterValues
End With
End Sub

Sub InverserFiltrage()
Dim i&, col%, d As Object
If Not ActiveSheet.AutoFilterMode Then GoTo 1
With ActiveSheet.AutoFilter.Range
  For i = 1 To .Parent.AutoFilter.Filters.Count
    If .Parent.AutoFilter.Filters(i).On Then
      If col Then MsgBox "Filtrez une seule colonne !": Exit Sub
      col = i
    End If
  Next
1 If col = 0 Then MsgBox "Aucun filtrage...": Exit Sub
  Set d = CreateObject("Scripting.Dictionary")
  For i = 2 To .Rows.Count
    If .Rows(i).Hidden Then d(.Cells(i, col).Text) = ""
  Next
  .AutoFilter col, d.keys, xlFilterValues
End With
End Sub

Fonctions personnalisées
Ces fonctions affiche les critères de filtres choisis

Function FiltreActuel(c, Optional typeCol As String)
 col = c.Column - Sheets(Application.Caller.Parent.Name).Range("_FilterDataBase").Column + 1
 feuille = Application.Caller.Parent.Name
 Application.Volatile
 If Sheets(feuille).FilterMode Then
    If Sheets(feuille).AutoFilter.Filters.Item(col).On Then
      temp = ActiveSheet.AutoFilter.Filters.Item(col).Criteria1
      If Left(temp, 2) = ">=" Or Left(temp, 2) = "<=" Then
         o = Left(temp, 2): n = Mid(temp, 3)
      Else
         If Left(temp, 1) = "=" Or Left(temp, 1) = ">" Or Left(temp, 1) = "<" Then
           o = Left(temp, 1): n = Mid(temp, 2)
         Else
           n = temp
         End If
      End If
      If typeCol = "D" Then n = Format(n, "dd/mm/yy")
      temp = o & n
      '---
      If Sheets(feuille).AutoFilter.Filters.Item(col).Operator Then
          oper = IIf(Sheets(feuille).AutoFilter.Filters.Item(col).Operator = 1, " ET ", " OU ")
          On Error Resume Next
          Err = 0
          temp2 = Sheets(feuille).AutoFilter.Filters.Item(col).Criteria2
          If Err = 0 Then
              If Left(temp2, 2) = ">=" Or Left(temp2, 2) = "<=" Then
                 o = Left(temp2, 2): n = Mid(temp2, 3)
              Else
                If Left(temp2, 1) = "=" Or Left(temp2, 1) = ">" Or Left(temp2, 1) = "<" _
                 Then o = Left(temp2, 1): n = Mid(temp2, 2)
              End If
              If typeCol = "D" Then n = Format(n, "dd/mm/yy")
              temp2 = o & n
           Else
              oper = ""
           End If
       End If
       FiltreActuel = temp & oper & temp2
    Else
      FiltreActuel = ""
    End If
  Else
      FiltreActuel = ""
  End If
End Function