Sub Macro2()
Dim ligne As Long, Compteur As Long
ligne = Cells(Rows.Count, 1).End(xlUp).Row
For ligne = 2 To ligne
Cells(ligne, 1).Resize(, 3).Copy
Compteur = Cells(Rows.Count, "F").End(xlUp).Row + 1
Cells(Rows.Count, "F").End(xlUp).Offset(1).PasteSpecial Paste:=xlValues, SkipBlanks:=True, Transpose:=True
Cells(Compteur, "G") = Cells(ligne, 4)
Compteur = Compteur + 1
Next
With Range(Cells(2, "G"), Cells(Compteur - 1, "G"))
.SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
.Value = .Value
End With
Range("G2").CurrentRegion.Cut Cells(ligne + 2, 1)
End Sub