Макрос листа1  
Option Explicit  
 
Sub vstavka()  
Dim iLastRow As Long  
Dim i As Long  
Dim n As Long  
 
iLastRow = Cells(Rows.Count, 2).End(xlUp).Row  
For i = iLastRow To 3 Step -1  
If Cells(i, 5) <> 1 Then  
   For n = 1 To Cells(i, 5) - 1  
       Cells(i, 5).EntireRow.Copy  
       Cells(i, 5).EntireRow.Insert xlDown  
   Next  
End If  
Next  
End Sub