Sub test()
Dim DerLigne As Integer, DerColonne As Integer
Dim I As Integer, J As Integer
Application.ScreenUpdating = False
DerLigne = Range("A" & Cells.Rows.Count).End(xlUp).Row
DerColonne = Cells(9, Cells.Columns.Count).End(xlToLeft).Column
For I = DerLigne To 10 Step -1
For J = DerColonne To 13 Step -3
If Cells(I, J) <> "" Then
If Cells(I, 13) <> "" Then
Rows(I).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range(Cells(I + 1, 1), Cells(I + 1, DerColonne)).Copy Range(Cells(I, 1), Cells(I, DerColonne))
End If
Range(Cells(I, J - 2), Cells(I, J)).Copy Range(Cells(I, 11), Cells(I, 13))
End If
Next J
Next I
Application.ScreenUpdating = True
End Sub