OnErrorGoTo qui ne marche qu'une fois...

Bonjour

Remplace la ligne qui bug par

If Selection.Find(What:=vnom, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False) Is Nothing Then GoTo 10

Bon courage

Bonjour fredl, Jacques87, le Forum,

On ne le répètera jamais assez, en VBA, il n'est pas utile (et même fortement déconseillé) de sélectionner les objets (feuilles, cellules notamment) pour pouvoir agir dessus.

Par ailleurs, l'utilisation des Goto n'est pas vraiment conseillée non plus.

Si tu le souhaites, tu trouveras ci-joint ton fichier avec une autre proposition de code pour tenter de reproduire ce que tu sembles vouloir obtenir. J'ai préféré utiliser ici une simple boucle pour la recherche du nom en lieu et place de la méthode Find, mais l'utilisation de cette méthode est tout à fait réalisable toutefois. J'ai supprimé ici le tri devenu, il me semble, inutile.

La procédure utilisée dans le fichier joint est la suivante (j'ai essayé de commenter le code au maximum pour t'aider à comprendre le principe) :

Sub Traitement()
Dim TabNoms As Variant, TabDonn As Variant
Dim L As Long, L2 As Long, Lresult As Long
      'On mémorise la liste de nom de la Feuil1 dans un tableau Variant temporaire
      With Sheets('Feuil1')
            L = .Range('A65536').End(xlUp).Row
            TabNoms = .Range(.Cells(1, 1), .Cells(L, 1)).Value
      End With
     
      'On mémorise les données Colonne B de la Feuille DTBS
      With Sheets('DTBS')
            L = .Range('A65536').End(xlUp).Row
            TabDonn = .Range(.Cells(1, 2), .Cells(L, 2)).Value
      End With

      With Sheets('DTBS')
            'Pour chaque nom de la liste mémorisée TabNoms
            For L = 1 To UBound(TabNoms, 1)
                  'On recherche le nom dans les données DTBS colonne 2 (TabDonn)
                  For L2 = 1 To UBound(TabDonn, 1)
                        If TabDonn(L2, 1) Like '*' & TabNoms(L, 1) & '*' Then
                              'On détermine le numéro de la première ligne libre de la Feuil2
                              Lresult = Sheets('Feuil2').Range('A65536').End(xlUp).Row + 1
                              'On recopie la ligne trouvée sur la Feuil2
                              .Rows(L2).Copy Destination:=Sheets('Feuil2').Rows(Lresult)
                        End If
                  Next L2
            Next L
      End With
     
      MsgBox 'Traitement terminé !'
End Sub

Cliquez pour agrandir...

Cordialement, [file name=PourFredl.zip size=14482]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/PourFredl.zip[/file]

ouaouhhhh!!!!!
top cool méga géant!
T'es un chef jacques!
Super merci
Nice we
Excellement.
Frédéric

Merci Jacques pour tes corrections.
ça, c'est de la programmation!
Comme j'aimerais etre capable d'écrire comme cela.
Je vais bien évidemment prendre comme exemple ce que tu as fais pour essayer de commencer à m'y mettre.
Mais ya du boulot, car je suis biochimiste autodidacte d'excel qui a betement commencé par 'outil/macro/enregistrement macro'...)
Mais je ne désespère pas.

Encore merci jacques!