Find...Next ne fonctionne pas

Bonjour à tous,

je viens vers vous, car après 5 jours de recherches, je n'arrive toujours pas à faire fonctionner mon code comme je l'aimerais bien. Soyez indulgents, je débute en VBA. Mes expériences en DB3 et Clipper datent d'il y a 30 ans et bien des choses ont changé.

La situation

J'importe un fichier texte, dont je ne garde que la colonne "A", après avoir éliminé les doublons et les lignes éventuellement vides au début. Ce fichier est différent à chaque fois, raison pour laquelle je compte le nombre de cellules non-vides pour utiliser cette variable dans une boucle For...Next. (feuille "RouteRiter")

Le but de cette partie du programme est d'aller rechercher toutes les occurrences dans la feuille "Annuaire" et de les copier dans la feuille "Liste" qui servira de base à un .PDF et un autre classeur Excel. Une occurrence peut être présente plusieurs fois sur des lignes différentes.

Le problème

En l'état actuel, la première occurrence est listée 2 fois, mais s'agit de la même ligne. "Loop While rngTrouve.Address <> FirstFound", semble ne pas fonctionner correctement.

L'occurrence suivante est bien trouvée et copiée, mais 1238 fois. J'en perds mon latin !

Pouvez-vous m'aider à résoudre ce problème ?

Je vous en remercie d'avance.

Rechercher les occurrences dans la feuille "Annuaire" et les copier dans la feuille "Liste"
Sheets("Annuaire").Select

For i = 1 To n 'n est le nombre de cellules renseignées dans la feuille "RouteRiter"

Set Plg = Columns("A:A")
With Plg
Set rngTrouve = ActiveSheet.Columns(1).cells.Find(What:=RR, LookAt:=xlWhole)
If Not (rngTrouve Is Nothing) Then
FirstFound = rngTrouve.Address
rngTrouve.Select
Ligne = ActiveCell.Row
Do
Rows(Ligne).Select
Application.CutCopyMode = False
selection.Copy

Sheets("Liste").Select 'Destination de la copie
cells(1, 1).Select

If ActiveCell = "" Then 'Test cellule vide
LigneListe = 1
ActiveCell(LigneListe, 1).Select
Else
LigneListe = LigneListe + 1
ActiveCell(LigneListe, 1).Select
End If

ActiveSheet.Paste

Sheets("Annuaire").Select
Set rngTrouve = .FindNext(rngTrouve)

Loop While rngTrouve.Address <> FirstFound

'Définir la prochaine occurren à rechercher -> RR
Sheets("RouteRiter").Select
RR = ActiveCell.Offset(1, 0).Value

Sheets("Annuaire").Select

Else
MsgBox ("Ce nom n'est pas répertorié")
Exit Sub
End If

End With

i = i + 1

Next

Bonsoir,

Proposition de correction, à tester

Sub test()
'Rechercher les occurrences dans la feuille "Annuaire" et les copier dans la feuille "Liste"
    Set wsa = Sheets("Annuaire") 'wsa=annuaire
    Set wsl = Sheets("Liste") 'wsl=liste
    Set wsr = Sheets("RouteRiter") 'wsr=RouteRiter
    dll = wsl.Cells(Rows.Count, 1).End(xlUp).Row 'dernière ligne utilisée de wsl
    dlr = wsr.Cells(Rows.Count, 1).End(xlUp).Row ' dernière ligne utilisée de wsr
    For i = 1 To dlr 'on parcourt toutes les lignes de wsr
        rr = wsr.Cells(i, 1)
        Set rngTrouve = wsa.Columns(1).Cells.Find(What:=rr, LookAt:=xlWhole) 'on cherche rr dans la colonne A de l'annuaire
        If Not (rngTrouve Is Nothing) Then
            FirstFound = rngTrouve.Address 'on a trouvé une occurrence, on sauve son addresse

            Do
                dll = dll + 1 ' incrémente n° de ligne de liste
                Ligne = rngTrouve.Row ' n° de ligne de l'annuaire contenant rr
                wsa.Rows(Ligne).Copy wsl.Cells(dll, 1) ' copie de la ligne de l'annuaire dans la liste
                Set rngTrouve =  wsa.Columns(1).Cells.FindNext(rngTrouve) 'on cherche l'occurrence suivante
            Loop While rngTrouve.Address <> FirstFound
        Else
            MsgBox ("Ce nom n'est pas répertorié")
            Exit Sub
        End If
    Next i
End Sub

Bonsoir,

quelle réactivité ! Merci pour la proposition de solution. Je vais tester cela demain matin. Si ça marche, je ne serai pas au bout de mes peines, ce n'est que le début. Reste à régler la réponse négative. Différents scenari sont possibles, mais je ne me suis pas encore fixé sur l'un ou l'autre. Le but serait d'avoir une "Liste complète" à sauvegarder en PDF et xslx sans avoir à retravailler le xlsx. Mouais, c'est peut-être pas très clair, mais si je rencontre des difficultés dans la réalisation de cette partie du projet, vous me permettrez de me retourner vers vous.

Amitiés

Bonjour,

Ok, c'est exactement cela. Bon, j'ai ramé un peu, mais j'ai fini par comprendre qu'il fallait déclaré wsa, wsl et wsr comm Object et les 2 autres variables comme Integer.

Merci pour votre aide.