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

     ТекстДляПоиска = "Наименование ценности"    ' удаляем строки с таким текстом

     ' перебираем все строки в используемом диапазоне листа
    For Each ra In ActiveSheet.UsedRange.Rows
         ' если в строке найден искомый текст
        If Not ra.Find(ТекстДляПоиска, , xlValues, xlPart) Is Nothing Then
             ' добавляем строку в диапазон для удаления
            If delra Is Nothing Then Set delra = ra Else Set delra = Union(delra, ra)
         End If
     Next
     ' если подходящие строки найдены - удаляем их
    If Not delra Is Nothing Then delra.EntireRow.Delete
End Sub