Sub Worksheet_Activate()
Application.ScreenUpdating = False
DL = Sheets("Données brutes").Range("A65500").End(xlUp).Row
tablo = Sheets("Données brutes").Range("A3:D" & DL) ' Tranfert dans array
With Sheets("Liste")
.Range("A2:Z1000").ClearContents ' Effacement matrice
For L = 1 To UBound(tablo)
Prénom = tablo(L, 1) ' extraction prénom en cours
If Application.CountIf(.Range("A:A"), Prénom) = 0 Then ' on regarde s'il existe
' première apparition du prénom
DL2 = .Range("A65500").End(xlUp).Row + 1 ' calcul première ligne vide
.Cells(DL2, "A") = tablo(L, 1): .Cells(DL2, "B") = tablo(L, 2) ' On range les quatre données
.Cells(DL2, "C") = tablo(L, 3): .Cells(DL2, "D") = tablo(L, 4)
Else
' le prénom est déjà présent
Ligne = Application.Match(Prénom, .Range("A:A"), 0) ' Ligne où prénom existe
Colonne = .Cells(Ligne, .Columns.Count).End(xlToLeft).Column ' Première cellule vide
.Cells(Ligne, Colonne + 1) = tablo(L, 2) ' On range les trois données
.Cells(Ligne, Colonne + 2) = tablo(L, 3)
.Cells(Ligne, Colonne + 3) = tablo(L, 4)
End If
Next L
End With
End Sub