Sub TextDel()
On Error GoTo ошибка
Dim str(3) As String, wb As String, sh, f, k, lr, txt, rr, tek, ek, Deletion As Collection
Set Deletion = New Collection
wb = ActiveWorkbook.Name: ek = False
For Each sh In Workbooks(wb).Sheets
If sh.Name = "LOG" Then Application.DisplayAlerts = False: sh.Delete: Application.DisplayAlerts = True
Next sh
For k = 1 To Workbooks(wb).Sheets.Count
txt = InputBox("Введите текст, сроки с которым будем удалять!", "Введите значение!")
If Len(txt) < 2 Then Exit Sub
sh = Workbooks(wb).Sheets(k).Name
Workbooks(wb).Sheets(sh).Select
поиск:
str(1) = "на листе - " & sh & " удалена строка - "
str(2) = " c текстом - "
str(3) = " в ячейке - "
Workbooks(wb).Sheets(sh).Cells(1, 1).Select
tek = 1
Workbooks(wb).Sheets(sh).Cells.Find(What:=txt, after:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
rr = ActiveCell.Row
If ek = False Then Deletion.Add str(1) & rr & str(2) & txt & str(3) & ActiveCell.Address: Workbooks(wb).Sheets(sh).Rows(rr).Delete Shift:=xlUp Else GoTo 11
ret1:
tek = rr
Cells.FindNext(after:=ActiveCell).Activate
If ActiveCell.Row <= tek Then GoTo 11
rr = ActiveCell.Row
If ek = False Then Deletion.Add str(1) & rr & str(2) & txt & str(3) & ActiveCell.Address: Workbooks(wb).Sheets(sh).Rows(rr).Delete Shift:=xlUp Else GoTo 11
GoTo ret1
11:
ek = False
Next k
Workbooks(wb).Sheets.Add.Name = "LOG"
Workbooks(wb).Sheets("LOG").Select
Workbooks(wb).Sheets("LOG").Cells(1, 1).Select
For f = 1 To Deletion.Count
Workbooks(wb).Sheets("LOG").Cells(f, 1).Value = Deletion.Item(f)
Next f
Exit Sub
ошибка:
If Err = 91 Then ek = True: Resume Next
End Sub