Sub ertert()
Dim r As Range, buDel As Boolean
Application.ScreenUpdating = False
Columns(1).UnMerge '1-ю колонку все-таки придется разъединить
With Range("A200").CurrentRegion
    For Each r In .Columns(2).SpecialCells(2).Areas
        If r.Cells(1, 1).Value Like "Перспективные*" Then buDel = True    'удалем "Перспективные*"
        If r.Cells(1, 1).Value Like "Текущие*" Then buDel = False
        If buDel Then r.Value = "True"
    Next r
End With

With Range("A1").CurrentRegion
    For Each r In .Columns(2).SpecialCells(2).Areas
        If r.Cells(1, 1).Value Like "Текущие*" Then buDel = True    'удалем "Текущие*"
        If r.Cells(1, 1).Value Like "Перспективные*" Then buDel = False
        If buDel Then r.Value = "True"
    Next r
End With
On Error Resume Next
Columns(2).SpecialCells(2, 4).EntireRow.Delete
Application.ScreenUpdating = True
End Sub