Добрый день, подскажите пожалуйста, как правильно преобразовать данный макрос (задача которого удалять строки, по содержимому значению) таким образом, чтобы при вызове его он сработал на всех листах книги.
Во вложении файл для тестирования макроса с названиями овощей/фруктов
Код
Sub Del_SubStr()
Dim sSubStr As String 'искомое слово или фраза(может быть указанием на ячейку)
Dim lCol As Long 'номер столбца с просматриваемыми значениями
Dim lLastRow As Long, li As Long
Dim lMet As Long
Dim arr
sSubStr = InputBox("Укажите значение, которое необходимо найти в строке", "Запрос параметра", "")
If sSubStr = "" Then lMet = 0 Else lMet = 1
lCol = 1
If lCol = 0 Then Exit Sub
lLastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
arr = Cells(1, lCol).Resize(lLastRow).Value
Application.ScreenUpdating = 0
Dim rr As Range
For li = 1 To lLastRow 'цикл с первой строки до конца
If -(InStr(arr(li, 1), sSubStr) > 0) = lMet Then
If rr Is Nothing Then
Set rr = Cells(li, 1)
Else
Set rr = Union(rr, Cells(li, 1))
End If
End If
Next li
If Not rr Is Nothing Then rr.EntireRow.Delete
Application.ScreenUpdating = 1
End Sub
Благодарю, учла ваше замечание. Корректно отформатировала код и добавила файл пример. Так же ознакомилась с уже поднятыми вопросами на форуме, однако не удалось внедрить в данный макрос предложенные решения. Буду благодарна за помощь
Цикл по всем листам книги, макрос в стандартный модуль
Код
Sub Del_SubStr()
Dim sSubStr As String 'искомое слово или фраза(может быть указанием на ячейку)
Dim lCol As Long 'номер столбца с просматриваемыми значениями
Dim lLastRow As Long, li As Long
Dim lMet As Long
Dim arr
Dim rr As Range
Dim Sht As Worksheet
sSubStr = InputBox("Укажите значение, которое необходимо найти в строке", "Запрос параметра", "")
If sSubStr = "" Then lMet = 0 Else lMet = 1
lCol = 1
If lCol = 0 Then Exit Sub
Application.ScreenUpdating = 0
For Each Sht In Worksheets
With Sht
lLastRow = .UsedRange.Row - 1 + .UsedRange.Rows.Count
arr = .Cells(1, lCol).Resize(lLastRow).Value
For li = 1 To lLastRow 'цикл с первой строки до конца
If -(InStr(arr(li, 1), sSubStr) > 0) = lMet Then
If rr Is Nothing Then
Set rr = .Cells(li, 1)
Else
Set rr = Union(rr, .Cells(li, 1))
End If
End If
Next li
If Not rr Is Nothing Then rr.EntireRow.Delete
Set rr = Nothing
End With
Next
Application.ScreenUpdating = 1
End Sub