Sub ВставкаПоКоду()
Set rngD = Application.InputBox(Prompt:="Выделите диапазон для " & Chr(13) _
& "вставки строк", Title:="Ввод диапазона", Type:=8)
rs = rngD.Item(1).Row
rf = rngD.Item(rngD.Count).Row
Application.ScreenUpdating = False

For i = rs To rf
If Cells(i + 1, 2) <> Cells(i, 2) Then
Rows(i + 1).Select
Selection.Copy
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
ActiveSheet.Paste
ActiveCell.Offset(, 22).Range("A1:H1").Select
Selection.ClearContents
Cells(i + 1, 4).Value = Cells(i + 1, 2)
End If

Next i

End Sub