XL 2010 Faire une recherche d'une partie d'une cellule en fonction d'une table

Option Explicit
Sub test()
Dim dico As Object, r As Range, cp As String, cf As String, e
    Set dico = CreateObject("Scripting.Dictionary")
    dico.CompareMode = 1
    With Sheets("CP zone acp")
        For Each r In .Range("d3", .Range("d" & .Rows.Count).End(xlUp))
            dico(CStr(r.Value)) = Empty
        Next
    End With
    With Sheets("data 1")
        For Each e In Split(.Cells(3, 4).Value, Chr(10))
            cp = Left(e, 5): cf = Right(e, Len(e) - 6)
            If dico.exists(cp) Then
                .Cells(3, 13).Value = .Cells(3, 13).Value & IIf(.Cells(3, 13).Value = Empty, Empty, Chr(10)) & e
            Else
                .Cells(3, 14).Value = .Cells(3, 14).Value & IIf(.Cells(3, 14).Value = Empty, Empty, Chr(10)) & e
            End If
        Next
    End With
End Sub