Sub FindDelete()
    Dim rf As Range, llastcell As Range
    Dim IsDown As Boolean
    'Запрашиваем какие строки удалять - ниже найденного или выше
    IsDown = (MsgBox("Удалить строки ниже?", vbYesNo, "Запрос") = vbYes)
    'пробуем найти фразу "ручной инструмент"
    '   фраза ищется по части ячейки, т.е. ячейка может помимо указанного значения содержать и другие
    '   чтобы искать точное соответствие, заменить xlPart на xlWhole
    On Error Resume Next
    Set rf = ActiveSheet.Cells.Find("ручной инструмент", , xlValues, xlPart, MatchCase:=False)
    On Error GoTo 0
    'если нашли
    If Not rf Is Nothing Then
        If IsDown Then 'удаляем все строки ниже найденной
            Set llastcell = ActiveCell.SpecialCells(11)
            Range(rf.Offset(1), llastcell).EntireRow.Delete
        Else 'удаляем все строки выше найденной
            Range("A1", rf.Offset(-1)).EntireRow.Delete
        End If
    End If
End Sub