Sub ДобавлениеСтроки()
     Dim ra As Range, delra As Range
     Application.ScreenUpdating = False    ' отключаем обновление экрана

     ' ищем строки, содержащие заданный текст
     ' (можно указать сколько угодно значений, и использовать подстановочные знаки)
     ДобавитьСтроку = Array("Итого (этап №*")
   
     ' перебираем все строки в используемом диапазоне листа
     For Each ra In ActiveSheet.UsedRange.Rows
         ' перебираем все фразы в массиве
         For Each word In ДобавитьСтроку
             ' если в очередной строке листа найден искомый текст
             If Not ra.Find(word, , xlValues, xlPart) Is Nothing Then
                 If delra Is Nothing Then Set delra = ra Else Set delra = Union(delra, ra)
             End If
         Next word
     Next

     If Not delra Is Nothing Then delra.EntireRow.Insert    ' добавляем строку
End Sub

                If delra Is Nothing Then Set delra = ra.Resize(3) Else Set delra = Union(delra, ra.Resize(3))

    Intersect(delra.Offset(-3, 6), Columns("G:H")).FormulaR1C1 = "=ROUND(RC3*RC[-2],0)"

    With Intersect(delra.Offset(-3, 6), Columns("G:H"))
         .FormulaR1C1 = "=ROUND(RC3*RC[-2],0)"
         Intersect(.Offset(, 2), Columns(9)).FormulaR1C1 = "=SUM(RC[-2]:RC[-1])"
     End With

    ReDim ДобавитьСтроку(3)
     ДобавитьСтроку(1) = Array("Вынос мусора", Empty, 1, "компл.", 0, 0)
     ДобавитьСтроку(2) = Array("Подъем", Empty, 1, "компл.", 0, 0)
     ДобавитьСтроку(3) = Array("Накладные расходы", Empty, 0.2, "компл.", 0, 1000)
     ДобавитьСтроку = WorksheetFunction.Transpose(WorksheetFunction.Transpose(ДобавитьСтроку))
     With delra.Offset(-3)
         For Each ra In Intersect(.Cells, Columns("A:F")).Areas
             ra.Value = ДобавитьСтроку
         Next
         Intersect(.Cells, Columns("G:H")).FormulaR1C1 = "=ROUND(RC3*RC[-2],0)"
         Intersect(.Cells, Columns(9)).FormulaR1C1 = "=SUM(RC[-2]:RC[-1])"
     End With

poisk = ActiveSheet.Columns("A:A").Find(What:="Накладные расходы").Row