Extraire email entre crochet et le copier dans un autre onglet

Bonjour,

j'écris une fonction pour copier les colonnes d'un onglet vers un autre et j'aimerai copier l'email qui est entre deux crochets, par exemple : Toto Isabelle<t.isabelle@gmail.com> j'aimerai extraire que la valeur t.isabelle@gmail.com et la copier dans un autre onglet

voici le code :

Function columnLookup(Name As String, Line As Range) As Integer
Dim i As Integer
Dim Cell As Range

i = 0
For Each Cell In Line
    If Cell.Value = Name Then
        i = Cell.Column
    End If
Next Cell

columnLookup = i
End Function

Sub copie()

    Dim k As Variant
    Dim localworksheet, globalWorksheet As String
    Dim currentLine, currentLine1 As Integer
    Dim classeur As Workbook

    Dim headerBase As Range
    Dim headerCopie As Range

    Dim indexNomBase, indexPrenomBase, indexEmailBase As Integer
    Dim indexNomCopie, indexPrenomCopie, indexEmailCopie As Integer

    globalWorksheet = "base"
    localworksheet = "copie"

    Worksheets(globalWorksheet).Activate

    'Choix du header

    Set headerBase = Worksheets(globalWorksheet).Range("A1", Worksheets(globalWorksheet).Range("A1").End(xlToRight))
    Set headerCopie = Worksheets(localworksheet).Range("A1", Worksheets(localworksheet).Range("A1").End(xlToRight))

    indexNomBase = columnLookup("Nom", headerBase)
    indexPrenomBase = columnLookup("Prénom", headerBase)
    indexEmailBase = columnLookup("Email", headerBase)

    indexNomCopie = columnLookup("Nom", headerCopie)
    indexPrenomCopie = columnLookup("Prénom", headerCopie)
    indexEmailCopie = columnLookup("Email", headerCopie)

    'Copier les informations

    currentLine1 = 2

    For k = 2 To 4

        Worksheets(localworksheet).Cells(currentLine1, indexNomCopie).Value = Worksheets(globalWorksheet).Cells(k, indexNomBase).Value
        Worksheets(localworksheet).Cells(currentLine1, indexPrenomCopie).Value = Worksheets(globalWorksheet).Cells(k, indexPrenomBase).Value
        Worksheets(localworksheet).Cells(currentLine1, indexEmailCopie).Value = Worksheets(globalWorksheet).Cells(k, indexEmailBase).Value

        currentLine1 = currentLine1 + 1

    Next k

End Sub

Bonjour mimich_88 et

Merci pour votre présentation

Si vous ne l'avez pas encore fait, je vous invite à lire ces quelques lignes qui vous aideront dans vos demandes
et réponses ainsi que sur les fonctionnalités (Nouveau Forum au bas de page notamment) de ce forum décrites par Sébastien
- La charte du forum
- Les fonctionnalites du forum

Merci pour votre participation sur le site Excel Pratique

Cordialement