اخى الفاضل وبعد اذن استازى ياسر
يمكنك استخدام الكود التالى فهو اكثر اختصارا
Sub khaled()
Application.ScreenUpdating = False
Cells(Rows.Count, 4).End(xlUp).Offset(1, 0).Select
Selection.EntireRow.Insert
Range("D" & Selection.Row).FillDown
Application.ScreenUpdating = True
End Sub