Sub AllerRetour()
'se lance par Ctrl+R
Dim t, ub&, i&, x$, j&, n%
Application.ScreenUpdating = False
Range("J:J", Columns(Columns.Count)).Delete 'RAZ
With Range("G1", Range("I" & Rows.Count).End(xlUp))
.Copy .Offset(, 3) 'copier-coller
.Columns(7) = "=G1&H1" 'colonne M auxiliaire
.Columns(8) = "=H1&G1" 'colonne N auxiliaire
t = .Columns(7).Resize(, 2) 'matrice, plus rapide
End With
ub = UBound(t)
For i = 1 To ub - 1
x = t(i, 1)
For j = i + 1 To ub
If t(j, 2) = x Then
Cells(i, "J").Resize(, 3).Cut Range("O1").Offset(, n) 'couper-coller
Cells(j, "J").Resize(, 3).Cut Range("O2").Offset(, n) 'couper-coller
n = n + 3
Exit For
End If
Next j, i
[J:N].Delete
Range("J:J", Columns(Columns.Count)).Columns.AutoFit 'ajustement largeur
Range("J1", Cells(1, Columns.Count)).SpecialCells(xlCellTypeConstants, 1).ColumnWidth = 4
With ActiveSheet.UsedRange: End With 'actualise la barre de défilement horizontale
End Sub