XL 2016 VBA - Est-il possible de récupérer toutes les valeurs de filtre possible sans parcourir la colonne

Sub a()
    Dim TabValeursDeFiltre As Variant
    Dim Rep As Variant
    Dim i As Integer
    Dim Area As Range
    Dim Range As Range
   
    Rep = Application.InputBox("Quel numéro de colonne ?", "Valeurs de filtre", 1, Type:=1)
    If VarType(Rep) = vbBoolean Then Exit Sub
   
    TabValeursDeFiltre = TabCriteria1FiltresColonneTS(ActiveSheet.ListObjects(1), CInt(Rep))
   
    Select Case VarType(TabValeursDeFiltre)
        Case vbArray + vbVariant
            For i = 1 To UBound(TabValeursDeFiltre)
                If TabValeursDeFiltre(i) = Empty Then TabValeursDeFiltre(i) = "(vide)"
            Next i
            MsgBox Join(TabValeursDeFiltre, vbCrLf)
       
        Case vbInteger
            If TabValeursDeFiltre = 0 Then MsgBox "Pas de valeurs de filtre pour la colonne #" & Rep & " !"
            If TabValeursDeFiltre = -1 Then MsgBox "La fonction ne peut pas récupérer les valeurs de filtre !"
    End Select
End Sub

'-------------------------------------------------------
'Critères de filtre d'une colonne d'un Tableau Structuré
'Return: Tableau (1-n) des valeurs des critères de filtre
'        0 si aucune valeur de filtre
'        -1 si c'est un cas non traité par la fonction
'-------------------------------------------------------
Private Function TabCriteria1FiltresColonneTS(Tbl As ListObject, TblNoColonne As Integer) As Variant
    Dim ReturnValue As Variant
    Dim Criteria1 As Variant
    Dim Criteria2 As Variant
    Dim Operator As Variant
    Dim ErrNumber As Long
    Dim i As Integer
   
    'Return value par défaut
    ReturnValue = 0

    With Tbl
        'Cas particulier où il n'y a pas de boutons de filtres retirés via Données/Filtrer
        If .AutoFilter Is Nothing Then GoTo SetReturnValue
       
        'Aucune colonne n'est filtrée
        If .AutoFilter.FilterMode = False Then GoTo SetReturnValue
        
        'Il n'y a pas de filtre sur la colonne demandée
        If Not .AutoFilter.Filters(TblNoColonne).On Then GoTo SetReturnValue

        With .AutoFilter
            Criteria1 = .Filters(TblNoColonne).Criteria1
            Operator = .Filters(TblNoColonne).Operator
           
            'Seuls opérateurs traités
            If Not (Operator = 0 Or Operator = xlFilterValues Or Operator = xlOr) Then
                'MsgBox "Function TabCriteria1FiltresColonneTS: Operator = " & Operator & "non supporté !"
                ReturnValue = -1
                GoTo SetReturnValue
            End If
           
            'Criteria1 = tableau de valeurs
            If IsArray(Criteria1) Then
                ReDim ReturnValue(1 To UBound(Criteria1))
                For i = LBound(Criteria1) To UBound(Criteria1)
                    ReturnValue(i) = IIf(Left(Criteria1(i), 1) = "=", Mid(CStr(Criteria1(i)), 2), CStr(Criteria1(i)))
                Next i
           
            'Critéria1 = une seule valeur
            Else
                'Cas particulier de l'exlusion de la valeur vide
                If Operator = 0 And Criteria1 = "<>" Then
                    'MsgBox "Function TabCriteria1FiltresColonneTS: Criteria1 = " & Criteria1 & "non supporté !"
                    ReturnValue = -1
                    GoTo SetReturnValue
                End If
               
                On Error Resume Next
                'Critéria2 = une valeur
                Criteria2 = .Filters(TblNoColonne).Criteria2
                Operator = .Filters(TblNoColonne).Operator
                ErrNumber = Err.Number
                On Error Resume Next
               
                If Err.Number = 0 And Operator = xlOr Then
                    ReDim ReturnValue(1 To 2)
                    ReturnValue(1) = IIf(Left(Criteria1, 1) = "=", Mid(CStr(Criteria1), 2), CStr(Criteria1))
                    ReturnValue(2) = IIf(Left(Criteria2, 1) = "=", Mid(CStr(Criteria2), 2), CStr(Criteria2))
                Else
                    ReDim ReturnValue(1 To 1)
                    ReturnValue(1) = IIf(Left(Criteria1, 1) = "=", Mid(CStr(Criteria1), 2), CStr(Criteria1))
                End If
            End If
        End With
    End With
   
SetReturnValue:
    'Return Value
    TabCriteria1FiltresColonneTS = ReturnValue
End Function

tabval = Application.Transpose(WorksheetFunction.Unique(tbl.DataBodyRange))

Sub d()
    Dim TabValeursUniques
    TabValeursUniques = TabclipBoardValeursUniquesColonneTS(ActiveSheet.ListObjects(1), 1)
    MsgBox Join(TabValeursUniques, vbCrLf)
End Sub

Function TabclipBoardValeursUniquesColonneTS(tbl As ListObject, TblNoColonne As Integer)
    Dim DataObj, texte
    tbl.DataBodyRange.Columns(TblNoColonne).SpecialCells(xlCellTypeVisible).Copy
    Set DataObj = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    DataObj.GetFromClipboard
    texte = Replace(DataObj.GetText, vbCrLf, "|")
    Application.CutCopyMode = False
    If Left(texte, 1) = "|" Then texte = "(vides)" & Mid(texte, 1, Len(texte) - 2)
    TabclipBoardValeursUniquesColonneTS = Split(texte, "|")
End Function