For Each cl In Intersect(ActiveSheet.UsedRange, rng)
            If Not cl.HasFormula Then cl.ClearContents
        Next cl

Sub НовийПодочетный()
Dim rng As Range, cl As Range
Application.ScreenUpdating = False
    Application.FindFormat.Clear
    Set rng = Range(Cells(ActiveCell.Row, 2), Cells(Rows.Count, 4))
    Debug.Print rng.Address
    Set cl = rng.Find(what:="Всего", LookIn:=xlValues, _
        lookat:=xlWhole, SearchDirection:=xlNext, MatchCase:=False)
    If Not cl Is Nothing Then
        FirstAddress = cl.Address
    End If
    Set rng = Rows(ActiveCell.Row & ":" & cl.EntireRow.Row)
        rng.Copy
        ActiveCell.EntireRow.Insert Shift:=xlUp
        Application.CutCopyMode = False
    On Error Resume Next
        Set rng = rng.SpecialCells(xlCellTypeConstants, xlNumberAsText)
    On Error GoTo 0
    If Not IsEmpty(rng) Then
        rng.ClearContents
    End If
Application.ScreenUpdating = True
End Sub

Set Rng = Range(Cells(ActiveCell.Row, 2), Cells(Rows.Count, 4))
    Debug.Print Rng.Address

Set rng = Rows(ActiveCell.EntireRow.Row & ActiveCell.EntireRow.Offset(3, 0).Row)

On Error Resume Next.
        Set Rng = ActiveCell.EntireRow.Offset(1, 0).SpecialCells(xlCellTypeConstants, xlNumberAsText) 'что должно получиться?
    On Error GoTo 0
    If Not IsEmpty(Rng) Then
        Rng.ClearContents
    End If

Sub ВставкаСтроки()
Application.ScreenUpdating = False
    ActiveCell.EntireRow.Insert Shift:=xlUp
    ActiveCell.EntireRow.Offset(1, 0).Copy
    ActiveCell.EntireRow.Select
    ActiveSheet.Paste
    Selection.Cells(4).Select
    Application.CutCopyMode = False
    On Error Resume Next
        Set Rng = ActiveCell.EntireRow.Offset(1, 0).SpecialCells(xlCellTypeConstants, xlNumberAsText)
    On Error GoTo 0
    If Not IsEmpty(Rng) Then
        Rng.ClearContents
    End If
Application.ScreenUpdating = True
End Sub

Sub iii()
Dim i As Integer
Dim ra As Range
For i = 8 To 16 Step 4
    For Each ra In ActiveSheet.UsedRange.Rows(i).Cells
        If ra.Value <> "Итого" Then
            ra.EntireRow.Delete
        Else
            If ra.Value = "Итого" Then ra.EntireRow.Hidden = False
        End If
    Next ra
Next i
End Sub

 For Each cl In trgt_rng.Rows
            If Len(cl.Cells(4).Value) > 0 Or _
                cl.Cells(15).Value <> 0 Or _
                cl.Cells(57).Value <> 0 Or _
                cl.Cells(58).Value <> 0 Or _
                cl.Cells(59).Value <> 0 _
                Then cl.Hidden = False ' отображаем строку
        Next cl

Sub макрос()
    Dim cell As Range
    Dim lRowNomber As Long
    Dim i As Long
    Dim Rng As Range
    Application.ScreenUpdating = False
    If Rows("5:153").Hidden = True Then
    Rows.Hidden = False
    End If
    For Each cell In ActiveSheet.UsedRange.Columns(3).Cells
        If cell.Value = "Èòîãî" Then
        cell.Activate
        lRowNumber = ActiveCellRow
        i = lRowNumber
        End If
    Next
    On Error Resume Next
    Set Rng = Range(Cells(5, 4), Cells(i - 1, 4)).EntireRow
    On Error GoTo 0
    Rng.Hidden = True
    If Rows(1).Hidden = False Then Rows(1).Hidden = True
    If Columns(1).Hidden = False Then Columns(1).Hidden = True
    Application.ScreenUpdating = True
End Sub

Sub Î÷èñòêà()
    Dim i As Integer
    Application.ScreenUpdating = False
    On Error Resume Next
    For i = 1 To 19
    ThisWorkbook.Sheets(i).Activate
    Set Rng = ActiveSheet.Range("B5:BG1000").SpecialCells(xlCellTypeConstants, xlNumberAsText)
    If Not IsEmpty(Rng) Then
        If MsgBox("Действительно удалить?", vbYesNo) = vbYes Then
            Rng.ClearContents
        End If
    Else
        MsgBox "Нет даных!"
    End If
    ActiveSheet.Range("B2").Select
    On Error GoTo 0
    Next i
    Application.ScreenUpdating = True
End Sub