Sub Transpose()
Dim dl As Long, x As Long, y As Long, t, plg As Range
With Feuil1
dl = .Range("A" & .Rows.Count).End(xlUp).Row
x = 2
Do
If x = dl Then
y = .Range("B" & .Rows.Count).End(xlUp).Row + 1
Else
y = .Range("A" & x).End(xlDown).Row
End If
Set plg = .Range("B" & x & ":B" & y - 1)
'Remplis le tableau t, des données de la plage
t = plg
.Range("B" & x).Resize(UBound(t, 2), UBound(t, 1)).Value = Application.Transpose(t)
.Range("B" & x + 1 & ":B" & y - 1).ClearContents
x = y
Loop Until x > dl
End With
End Sub