Sub Transfert()
Dim ncol%, dest As Range, dlig As Object, dcol As Object, lig&, destcol%, i&, x$
ncol = 5 'nombre de colonnes du tableau source
Set dest = [I5] 'cellule de destination
Set dlig = CreateObject("Scripting.Dictionary")
dlig.CompareMode = vbTextCompare 'la casse est ignorée
Set dcol = CreateObject("Scripting.Dictionary")
dcol.CompareMode = vbTextCompare 'la casse est ignorée
lig = dest.Row
destcol = dest.Column
Application.ScreenUpdating = False
dest.Resize(Rows.Count - lig + 1, Columns.Count - destcol + 1).Clear 'RAZ
For i = 5 To Cells(Rows.Count, 1).End(xlUp).Row
x = Cells(i, 1)
If dlig.exists(x) Then
Cells(dlig(x), dcol(x)).Resize(, ncol - 1) = Cells(i, 2).Resize(, ncol - 1).Value 'copie les valeurs
dcol(x) = dcol(x) + ncol - 1
Else
dlig(x) = lig
dcol(x) = destcol + ncol
Cells(lig, destcol).Resize(, ncol) = Cells(i, 1).Resize(, ncol).Value 'copie les valeurs
lig = lig + 1
End If
Next
With dest.EntireColumn.Resize(, Columns.Count - dest.Column + 1)
.ColumnWidth = 10.71
.AutoFit 'ajustement largeurs
End With
End Sub