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 :

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
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