Filtre automatique à choix multiple

Bonjour,

J'ai le code que vous pouvez retrouver ci-dessous qui me permet d'appliquer un filtre automatique sur des colonnes précisent en fonction de ce que j'ai sélectionné dans mon filtre. Sauf que je souhaiterais que chaque filtre dépendent les uns des autres donc que lorsque j'applique un filtre en U3 alors seul les lignes qui dépendent de la donnée (donc de ce qu'il trouve en colonne 16 don P) sortent et que si je souhaite y appliquer un autre filtre par exemple en U4 alors que le code applique les filtres en colonne P et en colonne R etc. Mais j'ai pu remarquer en essayant que ça ne fonctionnait pas notamment parce que parfois des cellules sont vides dans les colonnes P, K, Q et O (ce qui est normal certaines cellules doivent être vide). Pouvez vous m'aider ?

A savoir que dans mes cellules j'ai plusieurs données qui sont normalement séparer par des virgules et que j'ai considéré dans mon code.

Voici mon code :

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    On Error GoTo Exitsub
    Application.EnableEvents = False

    Dim Filters As Variant
    Dim i As Long, LastRow As Long
    Dim RowVisible As Boolean
    Dim SelectedValues As Variant, CellValues As Variant, val As Variant, cellVal As Variant
    Dim Delimiter As String: Delimiter = ", "

    ' Dictionnaire des cellules de filtres et leur colonne cible
    Filters = Array( _
        Array("U3", 16), _
        Array("U4", 18), _
        Array("U5", 11), _
        Array("U6", 10), _
        Array("U7", 19), _
        Array("U8", 17), _
        Array("U9", 15) _
    )

    ' Gérer la sélection multiple pour chaque filtre
    For i = LBound(Filters) To UBound(Filters)
        If Not Intersect(Target, Me.Range(Filters(i)(0))) Is Nothing Then
            If Target.Validation.Type = xlValidateList Then
                Dim NewValue As String, OldValue As String
                NewValue = Trim(Target.Value)
                Application.Undo
                OldValue = Trim(Target.Value)

                If OldValue = "" Then
                    Target.Value = NewValue
                Else
                    ' Créer un tableau des valeurs existantes
                    Dim ExistingValues() As String
                    ExistingValues = Split(OldValue, Delimiter)

                    ' Vérifier si la nouvelle valeur existe déjà
                    Dim ValueExists As Boolean: ValueExists = False
                    Dim NewValues As String: NewValues = ""

                    For Each val In ExistingValues
                        If Trim(val) = NewValue Then
                            ValueExists = True
                        Else
                            If NewValues <> "" Then NewValues = NewValues & Delimiter
                            NewValues = NewValues & val
                        End If
                    Next val

                    If ValueExists Then
                        Target.Value = NewValues
                    Else
                        Target.Value = OldValue & Delimiter & NewValue
                    End If
                End If
            End If
        End If
    Next i

    ' Appliquer les filtres cumulés
    LastRow = Me.Cells(Me.Rows.Count, "B").End(xlUp).Row
    Me.Rows.Hidden = False ' Réinitialiser l'affichage

    Dim RowIndex As Long
    For RowIndex = 20 To LastRow
        RowVisible = True

        ' Pour chaque filtre actif
        For i = LBound(Filters) To UBound(Filters)
            Dim FilterCell As Range: Set FilterCell = Me.Range(Filters(i)(0))
            Dim FilterCol As Integer: FilterCol = Filters(i)(1)

            ' Si le filtre contient des valeurs
            If Trim(FilterCell.Value) <> "" Then
                SelectedValues = Split(FilterCell.Value, Delimiter)
                Dim CellValue As String: CellValue = CStr(Me.Cells(RowIndex, FilterCol).Value)
                Dim MatchFound As Boolean: MatchFound = False

                ' Si la cellule n'est pas vide
                If Trim(CellValue) <> "" Then
                    ' Splitter les valeurs de la cellule
                    CellValues = Split(CellValue, Delimiter)

                    ' Comparer chaque valeur sélectionnée avec chaque valeur de la cellule
                    For Each val In SelectedValues
                        For Each cellVal In CellValues
                            If Trim(cellVal) = Trim(val) Then
                                MatchFound = True
                                Exit For
                            End If
                        Next cellVal
                        If MatchFound Then Exit For
                    Next val
                End If

                ' Masquer si aucune correspondance
                If Not MatchFound Then
                    RowVisible = False
                    Exit For
                End If
            End If
        Next i

        ' Appliquer le masquage
        Me.Rows(RowIndex).Hidden = Not RowVisible
    Next RowIndex

Exitsub:
    Application.EnableEvents = True
End Sub