creation de liste

=SI(LIGNES($2:2)<=NB.SI(Col_Critères;"Vert");INDEX(Col_Noms;PETITE.VALEUR(SI(Col_Critères="Vert";LIGNE(INDIRECT("1:"&LIGNES(Col_Noms))));LIGNES($2:2)));"")

Sub Par_couleur()
Dim MaListe, xRg As Range
Dim V, i As Long, Coul, Ville, U

Application.ScreenUpdating = False
' Création du dictionnaire
Set MaListe = CreateObject("Scripting.dictionary")
With Sheets("Feuil1")
    'transfert des données des colonnes 1 et 2 dans le tableau V
    V = Range(.Cells(2, 1), .Cells(.Rows.Count, "b").End(xlUp)).Value
    'boucle sur les lignes de V
    For i = 1 To UBound(V, 1)
        If MaListe.Exists(V(i, 2)) Then
            ' si la couleur existe on prend la valeur associée à la couleur
            ' et on concatène la ville précédée d'un slash
            MaListe(V(i, 2)) = MaListe(V(i, 2)) & "/" & V(i, 1)
        Else
            ' si la couleur n'existe pas, on ajoute la clef = couleur
            ' et on y associe la ville
            MaListe.Add V(i, 2), V(i, 1)
        End If
    Next i

    ' Récupération des couleurs et des villes concaténées de maliste dans deux tableaux
    Coul = MaListe.keys
    Ville = MaListe.items
    Set xRg = .Range("C1")
    ' Effacement ces colonens existantes
    .Range(Columns(3), Columns(.Range("C1").End(xlToRight).Column)).ClearContents
    ' Boucle sur les deux tableaux
    For i = 0 To MaListe.Count - 1
        ' afficher la couleur
        xRg = Coul(i)
        ' créer un tableau où chaque élément est une ville correspondant à la couleur en cours
        U = Split(Ville(i), "/")
        ' afficher les villes
        xRg.Offset(1).Resize(1 + UBound(U)) = Application.Transpose(U)
        ' passer à la colonne suivante
        Set xRg = xRg.Offset(, 1)
    Next i
End With
Application.ScreenUpdating = True
End Sub