Sub transposer()
Set src = Sheets("départ")
Set cible = Sheets("résultat")
derlig = src.Cells(src.Rows.Count, 4).End(xlUp).Row
tablo = src.Range("A5:D" & derlig)
Dim tablo2(), tablo3()
For lig = 1 To UBound(tablo)
If tablo(lig, 1) <> "" Then
x = x + 1
ReDim Preserve tablo2(1 To 4, 1 To x)
tablo2(1, x) = tablo(lig, 1)
tablo2(2, x) = tablo(lig, 2)
tablo2(3, x) = tablo(lig, 3)
Else
tablo2(4, x) = tablo2(4, x) & IIf(tablo2(4, x) = "", "", Chr(10)) & tablo(lig, 4)
End If
Next lig
cible.Cells.ClearContents
ReDim tablo3(x - 1, 3)
For i = 1 To x
For y = 1 To 4
tablo3(i - 1, y - 1) = tablo2(y, i)
Next y
Next i
cible.[A1].Resize(x, 4).Value = tablo3
End Sub