Макрос поиска и вывода строк, содержащих значение поиска

Sub FilterByCodeZontique()
    Dim rng As Range, c As Range, sToFind() As String
    Dim i As Long, n As Long, k As Long, f As Boolean
    Dim rFst As Long, rLst As Long
    Const codesToFind = "RU EN" 'Óêàæèòå íóæíûå êîäû ÷åðåç ïðîáåë.
    sToFind = Split(codesToFind)
    Application.ScreenUpdating = False
    With ActiveWorkbook
        n = .Sheets.Count
        With .Sheets("Report 1")
            With .UsedRange
                With .Find("Code")
                    k = .Column
                    rFst = .Row + 1
                End With
                rLst = .Row + .Rows.Count - 1
            End With
            Set rng = .Range(.Cells(rFst, k), .Cells(rLst, k))
            .Copy After:=ActiveWorkbook.Sheets(n)
        End With
        With .Sheets(n + 1)
            .Range(rng.Address).EntireRow.Delete
            For Each c In rng
                f = False
                For i = 0 To UBound(sToFind)
                    If c Like "*" & sToFind(i) & "*" Then
                        f = True
                        Exit For
                    End If
                Next i
                If f Then
                    c.EntireRow.Copy .Rows(rFst)
                    rFst = rFst + 1
                End If
            Next c
        End With
    End With
    Application.ScreenUpdating = True
End Sub

Sub FilterByCodeBorman()
    Dim wsh As Worksheet
    Dim rng As Range, c As Range, sToFind() As String
    Dim i As Long, n As Long, k As Long, f As Boolean
    Dim rFst As Long, rLst As Long
    Const codesToFind = "POLZUNOV OVCHINNIKOV" 'Укажите нужные фамилии через пробел.
    sToFind = Split(codesToFind)
    Application.ScreenUpdating = False
    With ActiveWorkbook.Sheets
        'Получаем ссылку на анализируемый столбец.
        With .Item("Report 1")
            With .UsedRange
                With .Find("Code")
                    k = .Column
                    rFst = .Row + 1
                End With
                rLst = .Row + .Rows.Count - 1
            End With
            Set rng = .Range(.Cells(rFst, k), .Cells(rLst, k))
        End With
        'Смотрим, есть ли листы с нужными фамилиями.
        'Если листов нет - то копируем данные в новые листы.
        'Если есть - то копируем данные в имеющиеся листы.
        For i = 0 To UBound(sToFind)
            On Error Resume Next
            Set wsh = .Item(sToFind(i))
            On Error GoTo 0
            If wsh Is Nothing Then
                .Item("Report 1").Copy After:=.Item(.Count)
                .Item(.Count).Name = sToFind(i)
            Else
                rng.EntireRow.Copy wsh.Rows(wsh.UsedRange.Row + wsh.UsedRange.Rows.Count)
                Set wsh = Nothing
            End If
        Next i
        'В анализируемом столбце убираем строки, в которых обнаружены
        'искомые фамилии.
        For k = rng.Cells.Count To 1 Step -1
            Set c = rng.Cells(k)
            f = False
            For i = 0 To UBound(sToFind)
                If c Like "*" & sToFind(i) & "*" Then
                    f = True
                    Exit For
                End If
            Next i
            If f Then
                c.EntireRow.Delete
            End If
        Next k
        'Анализируем столбцы в листах с данными по фамилиям - в них,
        'наоборот, удаляем строки, в которых не обнаружено искомой
        'фамилии.
        For i = 0 To UBound(sToFind)
            With .Item(sToFind(i))
                With .UsedRange
                    With .Find("Code")
                        k = .Column
                        rFst = .Row + 1
                    End With
                    rLst = .Row + .Rows.Count - 1
                End With
                Set rng = .Range(.Cells(rFst, k), .Cells(rLst, k))
            End With
            For k = rng.Cells.Count To 1 Step -1
                Set c = rng.Cells(k)
                If Not c Like "*" & sToFind(i) & "*" Then c.EntireRow.Delete
            Next k
        Next i
    End With
    Application.ScreenUpdating = True
End Sub