Sub Worksheet_Activate()
Dim Couleur$, Motorisation$, Prénom$, DL%, L%, i%
Application.ScreenUpdating = False
[A2:A1000].ClearContents
DL = Feuil1.Range("A65500").End(xlUp).Row ' Dernière ligne tableau
Range("A2:A" & DL - 2) = Feuil1.Range("A4:A" & DL).Value ' Copier Coller Prénoms dans Feuil2
ActiveSheet.[A:A].RemoveDuplicates Columns:=1, Header:=xlYes ' Suppression doublons
With Feuil1
For L = 2 To Range("A65500").End(xlUp).Row ' Pour tous les prénoms
Prénom = Cells(L, "A"): Couleur = "": Motorisation = "" ' On récupère Couleur et Motorisation
For i = 4 To DL ' Pour toutes les lignes du tableau d'entrée
If .Cells(i, "A") = Prénom Then ' Si c'est le même prénom
If InStr(1, Couleur, .Cells(i, "B")) = 0 Then ' Si la couleur n'est pas présente on la rajoute
Couleur = Couleur & " , " & .Cells(i, "B")
End If
If InStr(1, Motorisation, .Cells(i, "C")) = 0 Then ' Si la motorisation n'est pas présente on la rajoute
Motorisation = Motorisation & " , " & .Cells(i, "C")
End If
End If
Next i
Cells(L, "B") = Mid(Couleur, 4) ' On copie les valeurs en supprimant la virgule initiale
Cells(L, "C") = Mid(Motorisation, 4)
Next L
End With
Columns.AutoFit ' On ajuste la largeur des colonnes
[A:C].Borders.Weight = xlThin ' On met les bordures
End Sub