Copy filtered Data with Criteria

Dim rowcount As Long, myrng As Range, cell
Sub copyFilteredData()
rowcount = ThisWorkbook.Sheets(1).Cells(Rows.Count, 2).End(xlUp).Row
Set myrng = ThisWorkbook.Sheets(1).Range("B2:B" & rowcount)
For Each cell In myrng
        If cell.Value Like "*LF*" Then
            cell.Offset(0, 1) = 0
        Else
            cell.Offset(0, 1) = 1
        End If
Next
ThisWorkbook.Sheets(1).Range("A1:B" & rowcount).AutoFilter field:=2, Criteria1:="*LF*"
ThisWorkbook.Sheets(1).Range("A1:B" & rowcount).SpecialCells(xlCellTypeVisible).Copy
ThisWorkbook.Sheets("Lost").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteAll
ThisWorkbook.Sheets(1).ShowAllData
ThisWorkbook.Sheets(1).Range("A1:B" & rowcount).AutoFilter field:=2, Criteria1:="<>*LF*"
ThisWorkbook.Sheets(1).Range("A1:B" & rowcount).SpecialCells(xlCellTypeVisible).Copy
ThisWorkbook.Sheets("State").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteAll

End Sub

Download file