Sub Transfert()
Dim DL%, L%, i%, j%, tablo(), tablo2(), Nom(), T0
T0 = Timer
Application.ScreenUpdating = False
DL = Range("A65500").End(xlUp).Row
tablo = Range("A1:D" & DL)
ReDim tablo2(DL, 3)
ReDim Nom(4)
For L = 2 To UBound(tablo)
Nom(2) = Cells(1, 2): Nom(3) = Cells(1, 3): Nom(4) = Cells(1, 4)
For i = 2 To 4
For j = 2 To 4
If tablo(L, i) > tablo(L, j) Then
buffer1 = tablo(L, j): buffer2 = Nom(j)
tablo(L, j) = tablo(L, i): Nom(j) = Nom(i)
tablo(L, i) = buffer1: Nom(i) = buffer2
End If
Next j
Next i
tablo2(L - 2, 0) = tablo(L, 1)
For i = 1 To 3
tablo2(L - 2, i) = Nom(i + 1)
Next i
Next L
Range("$F$2").Resize(DL, 4) = tablo2
[E4] = "Temps de transfert : " & Round(1000 * (Timer - T0)) & "ms."
End Sub