Automatiser une recherche

[zmimi83]

Bonjour à tous,

J'ai un petit soucis, j'ai, dans une feuille "adresses email" d'un classeur trois colonnes contenant les Prénoms, Noms et Adresses email d'une liste de diffusion. Dans une deuxième feuille, une colonne contenant des adresses email. Ces adresses email détermineront les lignes à supprimer dans la page d'adresses.

Voici la macro que je voudrais éxécuter en l'automatisant (pour qu'elle supprime dans la pages d'adresses autant de lignes que stipulé dans la feuille à supprimer.

J'ai donc deux problèmes :

1 - Le collage des données copiées dans la feuille "à supprimer" dans l'outil de recherche

2 - Le codage de la boucle

Merci d'avance pour l'aide à un débutant en VBA

Voici le code de la macro :

Sub SuppressionAddress()
'
' SuppressionAddress Macro
'
' Touche de raccourci du clavier: Ctrl+s
'
    Range("A1").Select
    Sheets("adresses email").Select
    Range("A1").Select
    Selection.Copy
    Sheets("à supprimer").Select
    Cells.Find(What:="[COLOR="Red"][B]résultat de la copie de la cellule A1 de la feuille "à supprimer"[/B][/COLOR]", After:=ActiveCell, LookIn:= _
        xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
        xlNext, MatchCase:=False, SearchFormat:=False).Activate
    Range(Selection, Selection.End(xlToLeft)).Select
    Application.CutCopyMode = False
    Selection.EntireRow.Delete
    Range("A1").Select
    Sheets("à supprimer").Select
    Range("A1").Select
    Selection.EntireRow.Delete
    Sheets("adresses email").Select
    Range("A1").Select
End Sub

 

[fanfan38]

Re : Automatiser une recherche

Bonjour zmimi83 et bienvenue sur Excel-download.
Perso je verrai bien
deradres=Sheets("adresses email").range("a65500").end(xlup).row
derlig=Sheets("à supprimer").range("a65500").end(xlup).row
for i=1 to deradres
mavar = Sheets("adresses email").cells(i,3).Value
trouve = 1
With Worksheets("à supprimer").Range("a1:a" & derlig)
Set c = .Find(mavar, LookIn:=xlValues)
If Not c Is Nothing Then trouve = 0
End With
if trouve=0 then
Sheets("adresses email").cells(i,3).entirerow.delete
endif
next

Ps: un fichier joint (compressé) est le bienvenu...(moins de 48k)
A+ François

 

[pierrejean]

Re : Automatiser une recherche

bonjour zmimi83

Teste:

Sub SuppressionAddress()
'
' SuppressionAddress Macro
'
' Touche de raccourci du clavier: Ctrl+s
'
 
 Sheets("adresses email").Select
 For n = 1 To Sheets("Feuil1").Range("A65536").End(xlUp).Row
    Set c = Sheets("adresses email").Cells.Find(What:=Sheets("à supprimer").Range("A" & n), LookIn:= _
        xlFormulas, LookAt:=xlPart)
     If Not c Is Nothing Then
        Sheets("adresses email").Rows(c.Row).Delete
     End If
 Next n
End Sub

edit Salut fanfan

 

[zmimi83]

Re : Automatiser une recherche

Merci les gars !!! Louable effort !!!

A Fanfan : ça marche nickel !!! trop fort !!!