Sub ComparoList
Dim Rng As Range
Dim Dn As Range
Dim Ray()
Dim Q As Variant
Dim c As Long
Dim n As Long
c = 1
Range("K1:P1").Value = Array("Nom", "jour 1", "jour 2", "jour 3", "jour 4", "jour 5")
With CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
ReDim Ray(1 To 500, 1 To 6)
For n = 0 To 4
Set Rng = Range("B2:B500").Offset(, n)
For Each Dn In Rng
If Not Dn.Value = vbNullString Then
If Not .Exists(Dn.Value) Then
c = c + 1
Ray(c, 1) = Dn.Value
Ray(c, Dn.Column) = Range("A" & Dn.Row)
.Add Dn.Value, c
Else
Ray(.Item(Dn.Value), Dn.Column) = Range("A" & Dn.Row)
End If
End If
Next Dn
Next n
End With
Range("K2").Resize(500, 6) = Ray
End Sub