Sub ItemsPourUnCode()
Set d1 = CreateObject("Scripting.Dictionary")
With Feuil1
a = .Range("C1:D" & .Range("A65365").End(xlUp).Row)
j = 0
For i = LBound(a) To UBound(a)
If Not d1.exists(a(i, 1)) Then j = j + 1: d1(a(i, 1)) = j
Next i
Dim Tbl(): ReDim Tbl(1 To d1.Count, 1 To 5)
Set d2 = CreateObject("Scripting.Dictionary")
For i = LBound(a) To UBound(a)
d2(a(i, 1)) = d2(a(i, 1)) + 1
Tbl(d1(a(i, 1)), 1) = a(i, 1)
Tbl(d1(a(i, 1)), d2(a(i, 1)) + 1) = a(i, 2)
Next
End With
With Feuil2
.Cells.Clear
.[A1].Resize(d1.Count, 5) = Tbl
'complète ligne en-tete
DerCol = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column 'donne n° dernière colonne non vide
If DerCol <> 1 Then
For i = 1 To DerCol - 1
.Cells(1, i + 1) = i
Next i
End If
End With
End Sub