[COLOR="DarkSlateGray"]Sub toto()
Dim i As Long
For i = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
Rows(i).Insert Shift:=xlDown
Rows(i).Insert Shift:=xlDown
Cells(i + 2, 1).Resize(1, 2).Cut Destination:=Cells(i, 1).Resize(1, 2)
Cells(i + 2, 3).Resize(1, 2).Cut Destination:=Cells(i + 1, 1).Resize(1, 2)
Cells(i + 2, 5).Resize(1, 2).Cut Destination:=Cells(i + 2, 1).Resize(1, 2)
Next i
End Sub[/COLOR]