Sub Tranfert()
Application.ScreenUpdating = False
DL = [A65500].End(xlUp).Row
T = Range("A6:C" & 1 + DL): Taille = Int(1 + UBound(T) / 2)
ReDim TS(Taille, 5): Ind = 0
For L = 1 To UBound(T) Step 2
TS(Ind, 0) = T(L, 1): TS(Ind, 1) = T(L + 1, 1)
TS(Ind, 2) = T(L, 2): TS(Ind, 3) = T(L + 1, 2)
TS(Ind, 4) = T(L, 3): TS(Ind, 5) = T(L + 1, 3)
Ind = Ind + 1
Next L
With Sheets("Résultat").[A3:F65000]
.ClearContents: .Borders.LineStyle = xlNone
End With
With Sheets("Résultat")
.[A3].Resize(UBound(TS, 1), 1 + UBound(TS, 2)) = TS
.Range("A1:F" & .[A65500].End(xlUp).Row).Borders.Weight = xlThin
.Select
End With
End Sub