Sub dupliquer()
Dim derlig&, dercol&, i&, n&
Application.ScreenUpdating = False
With ActiveSheet
derlig = .Cells(.Rows.Count, "a").End(xlUp).Row
dercol = .Cells(1, .Columns.Count).End(xlToLeft).Column
For i = derlig To 2 Step -1
n = .Cells(i, "d")
If n > 1 Then
.Cells(i, "a").Resize(, dercol).Copy
.Cells(i, "a").Resize(n - 1, dercol).Insert Shift:=xlDown
End If
Next i
End With
Application.CutCopyMode = False
End Sub