Looping in text filter - excel

Question

I have this code which cuts and pastes an entire row to another sheet. When i set values as = it works, but when i set to like or contains, the loop doesnt happen. The value of the filter i'm looking for would keep changing including with a unique phrase. Eg: 1. Overlap error: 1234, 1. Overlap error:1235 etc.
Sub loopMe()
Dim sh As Worksheet, ws As Worksheet
Dim LstR As Long, rng As Range, c As Range
Set sh = Sheets("Sheet1") 'set the sheet to loop
Set ws = Sheets("Sheet2") 'set the sheet to paste
With sh 'do something with the sheet
LstR = .Cells(.Rows.Count, "BE").End(xlUp).Row 'find last row
Set rng = .Range("BE5:BE" & LstR) 'set range to loop
End With
'start the loop
For Each c In rng.Cells
'If c = "1. Overlap error:" Then
If c.Value Like "*1. Overlap error:*" Then
'If Left(c.Value, 17) = "1. Overlap error:" Then
'If InStr(1, c, "1. Overlap error:") > 0 Then
c.EntireRow.Copy ws.Cells(ws.Rows.Count, "A").End(xlUp).Offset(1) 'copy row to first empty row in sheet2
c.EntireRow.Delete Shift:=xlUp
End If
Next c
End Sub

Answer 1

You can use a filter to find the data, move it and delete the rows.
Sub ed()
Dim sh As Worksheet, ws As Worksheet
Dim rng As Range
Set sh = Sheets("Sheet1")
Set ws = Sheets("Sheet2")
With sh
.Range("BE4").AutoFilter Field:=1, Criteria1:= _
"=*1. Overlap error:*", Operator:=xlAnd
Set rng = .Range("BE5:BE" & .Cells(.Rows.Count, "BE").End(xlUp).Row)
With ws
rng.SpecialCells(xlCellTypeVisible).EntireRow.Copy ws.Cells(ws.Rows.Count, "A").End(xlUp).Offset(1)
End With
rng.EntireRow.Delete
.AutoFilterMode = False
End With
End Sub

Answer 2

So if you prefer your original approach,
Sub loopMe()
Dim sh As Worksheet, ws As Worksheet
Dim LstR As Long, c As Range
Set sh = Sheets("Sheet1")
Set ws = Sheets("Sheet2")
'find last row
LstR = sh.Range("BE65000").End(xlUp).Row
Dim irow
For irow = LstR To 5 Step -1
Set c = sh.Range("BE" & irow)
If c.Value Like "*1. Overlap error:*" Then
'copy row to first empty row in sheet2
c.EntireRow.Copy ws.Cells(65000, 1).End(xlUp).Offset(1, 0)
c.EntireRow.Delete Shift:=xlUp
End If
Next irow
End Sub