Sub backToTheOrigin()
Set f1 = Sheets("Feuil1")
Set f2 = Sheets("Feuil2")
If f1.[F5] = "" Then MsgBox "rien à transposer": Exit Sub
lig = 2
If f2.[A2] <> "" Then f2.Cells(2, 1).Resize(f2.Cells(Rows.Count, 1).End(xlUp).Row, 3).ClearContents
For Each c In f1.Cells(5, 6).Resize(f1.Cells(Rows.Count, 6).End(xlUp).Row - 4, 1)
For col = 1 To 4
If c.Offset(0, col) <> "" Then
f2.Cells(lig, 1) = c
f2.Cells(lig, 2) = c.Offset(0, col)
f2.Cells(lig, 3) = c.Offset(0, col + 4)
lig = lig + 1
End If
Next col
Next c
End Sub