Extraire des caractères d'une cellule

=INDEX(Données!$A$1:$A$7;MIN(SI(ESTNUM(CHERCHE(Données!$A$1:$A$7;G2));LIGNE(Données!$A$1:$A$7))))

Option Base 1
Function ExtractNom(Plage As Range, Phrase As String) As String

TabRch = Range(Plage.Address)

'*** ------------------------------------------------------------------------------
' Tableau d'objet
Dim Tabreg() As Object
ReDim Tabreg(LBound(TabRch, 1) To UBound(TabRch, 1), 1 To 2)
Dim TabMatches() As Object
ReDim TabMatches(LBound(TabRch, 1) To UBound(TabRch, 1), 1 To 2)
'*** ------------------------------------------------------------------------------
For i = LBound(Tabreg, 1) To UBound(Tabreg, 1)
    Set Tabreg(i, 1) = CreateObject("vbscript.regexp")
        ' ici laissé pour l'ordre !
        'Phrase= "Phrase"
        'Le Pattern est le motif que l'on recherche
        Tabreg(i, 1).Pattern = TabRch(i, 1)
        ' Active ou non la recherche sur plusieurs lignes à la fois / La propriété est mise sur False par défaut.
        Tabreg(i, 1).MultiLine = False
        ' Précise si la recherche est sensible ou non à la casse (majuscules/minuscules) / La propriété est mise sur False par défaut.
        Tabreg(i, 1).IgnoreCase = True
        ' Précise si la recherche porte sur la première occurence ou sur toutes / La propriété est mise sur False par défaut.
        Tabreg(i, 1).Global = True
        'le test renvoie un Boolean (parfait pour notre fonction Booléenne!!!)
        'MsgBox Tabreg(i, 1).test(Phrase)
        ' Cette méthode permet d'explorer les occurences qui vérifient le Pattern.
        Set TabMatches(i, 1) = Tabreg(i, 1).Execute(TabRch(i, 1))
'*** ------------------------------------------------------------------------------
            ' Resultat
            If Tabreg(i, 1).test(Phrase) = True Then
                ExtractNom = Tabreg(i, 1).Pattern
                Exit For
            End If
            Next i
End Function