Sub Макрос4()
  
On Error Resume Next
   
    Set x = Range("A:I").Find("*Итого по разделу*")
    Set y = Range("A:I").FindNext(x)
    Set Z = Range("A:I").FindNext(y)
    Set w = Range("A:I").FindNext(Z)
    Set w2 = Range("A:K").Find("*Так же предлагаем выполнить все работы*")
    Rows(Range("ИТОГИ4").Row - 1).Copy
    Rows(Range("ИТОГИ4").Row + 0).Insert Shift:=xlDown
    Cells(w.Row - 1, 1) = Left(Cells(w.Row - 2, 1), InStr(1, Cells(w.Row - 2, 1), ".") - 1) & "." _
    & Val(Right(Cells(w.Row - 2, 1), Len(Cells(w.Row - 2, 1)) _
        - InStr(1, Cells(w.Row - 2, 1), "."))) + 1
    Cells(w.Row - 1, 9) = 1
    Cells(w.Row, 10).FormulaLocal = "=СУММ(K" & w2.Row + 2 & ":K" & w.Row - 1 & ")"
    Range("J" & w.Row - 2).AutoFill Destination:=Range("J" & w.Row - 2 & ":J" & w.Row - 1)
    Range("K" & w.Row - 2).AutoFill Destination:=Range("K" & w.Row - 2 & ":K" & w.Row - 1)
    ActiveSheet.Shapes.Range(Array("Picture 7")).IncrementTop 15.75
End Sub