Private Sub CommandButton1_Click()
Dim i&, j&, LstRw&, LstCol&, D As Object
Dim TabDate(), TabTmp As Variant
Set D = CreateObject("Scripting.Dictionary")
With Sheets("Feuil1")
LstRw = .Cells(Rows.Count, 1).End(xlUp).Row
LstCol = .Cells(1, Columns.Count).End(xlToLeft).Column
For i = 2 To LstRw
For j = 6 To LstCol
If .Cells(i, j).Value <> "" Then _
D(.Cells(i, j).Value) = _
D(.Cells(i, j).Value) & .Cells(i, 3).Value & ";"
Next j
Next i
End With
TabDate = D.Items
With Sheets("Feuil2")
.Range(.Cells(2, 1), .Cells(Rows.Count, 9)).ClearContents
.Cells(2, 1).Resize(D.Count, 1) = Application.Transpose(D.Keys)
For i = LBound(TabDate) To UBound(TabDate)
TabTmp = Split(TabDate(i), ";")
.Cells(i + 2, 2).Resize(1, UBound(TabTmp)) = TabTmp
Next i
End With
End Sub