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
|
Sub RechercheMailto()
Dim Plage As Range
Dim Ligne As Range
Dim Cel As Range
'défini la plage de recherche en feuille Feuil1 (à adapter)
With Worksheets("Feuil1")
Set Plage = .Range(.Cells(1, 1), .Cells(.Rows.Count, 26).End(xlUp))
End With
'parcour la plage ligne par ligne à la recherche du caractère @
'si trouvé, la ligne est copiée en feuille Feuil2 (à adapter)
'puis elle est supprimée
For Each Ligne In Plage.Rows
Set Cel = Ligne.Find("@", , xlValues, xlPart)
If Not Cel Is Nothing Then
With Worksheets("Feuil2")
Ligne.Copy .Range("A" & .Cells(.Rows.Count, 1).End(xlUp).Row + 1)
Ligne.EntireRow.Delete
End With
End If
Next Ligne
End Sub |
