Fin de boucler sur une recherche

Bonjour, j'ai fait une boucle dans laquelle j'utilise une recherche de mot. Ma feuille contient 3400 ligne environ. Ma boucle me trouve tout les mots recherchés et copie l'information que j'ai besoin. Mais ma boucle lorsqu'elle a fait les quelques 3400 ligne, recommence au début et cela sans fin. Comment on fait pour que la boucle s'arrête à la première ligne vide? J'ai essayé des chose comme: "Range("A65536").End(xlUp).Offset(1, 0).Select" mais ma boucle ne fonctionne plus.

Voilà mon code:

Sub Macro1()

Dim r As String

Range("a1").Select

Cells.Find(What:="largeur", After:=ActiveCell, LookIn:=xlFormulas, _

LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _

MatchCase:=False, SearchFormat:=False).Activate

r = Selection.Value

ActiveCell.Offset(0, 1).Select

Selection.Copy

Do while r = "LARGEUR"

Cells.Find(What:="LONGUEUR", After:=ActiveCell, LookIn:=xlFormulas, _

LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _

MatchCase:=False, SearchFormat:=False).Activate

ActiveCell.Offset(0, 2).Select

ActiveSheet.Paste

Cells.Find(What:="LARGEUR", After:=ActiveCell, LookIn:=xlFormulas, _

LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _

MatchCase:=False, SearchFormat:=False).Activate

ActiveCell.Offset(0, 1).Select

Selection.Copy

Loop

End Sub

J'espère avoir été assez claire dans mes informations. J'ai joint un fichier pour l'exemple.

merci de votre aide.

Bonjour

infodes a écrit :

J'ai joint un fichier pour l'exemple

Et bien non

Ben désolé, le site ne prends pas mon fichier. Ça fait 3 fois que j'essaie et ça ne fonctionne pas. Je vais faire d'autres essaies.

Bonjour

Si ton fichier (compressé au besoin) maxi 300Ko

Sinon tu as (entre autres) cjoint http://cjoint.com/index.php

Bon c'est fait. Mon fichier était beaucoup trop gros. Je l'a ramené à 2000 lignes.

merci

Bonjour

Cela serait bien d'indiquer ce que tu veux faire

Ce que j'ai compris

Tu recherche "Largeur" et une fois trouvé, tu récupères la cellule à droite, ensuite tu cherches "Longueur" et tu copies dans la 2éme cellule à droite ce que tu avais récupéré

Exemple

"Largeur" en U3 --> tu récupères "CANADA"

ActiveCell.Offset(0, 1).Select
Selection.Copy

Ensuite tu trouves "Longueur" en Q5 et dans la colonne S tu écris "CANADA" !!!!!

ActiveCell.Offset(0, 2).Select
ActiveSheet.Paste

bonjour Banzai64, oui c'est exactement ce que je fais avec ma macro. Tout cela fonctionne très bien mais la boucle est infini. Lorsqu'elle arrive à la fin, elle reprend au départ. Moi je voudrais qu'elle arrête à la dernière ligne pleine car, après, je dois reprendre la recherche mais avec d'autres mots. J'espère que c'est plus claire comme cela.

merci

Bonsoir

Excuses-moi mais j'ai des doutes

J'ai juste lance la macro

Et dans la cellule S4 (colonne Modèle) on marque "CANADA" et dans la cellule W12 (colonne Qté en main ) on marque "CANADA"

Je veux bien t'aider à trouver une solution, mais quand cela me semble aberrant je n'y arrive pas

Il faut que tu fasses un exemple de résultat à trouver (colorises les cellules qui sont recopiées)

Je suis désolé, je n'ai pas envoyé le bon fichier. Je suis pas mal dans le jus aujourd'hui et je suis allé trop vite. Je m'excuse de vous avoir fait perdre votre temps.

À force de faire des tests, je me rend compte que c'est impossible à faire. Il ne peut pas trouver de cellule vide car la recherche l'envoie toujours sur un mot. Y-a-t-il un moyen de dire à la macro qu'il y a 3484 ligne et que lorsqu'il arrive dans les 3000 lignes, qu'il doit passer à la commande suivante s'il ne trouve plus le mot qu'il recherche: ex: dans le premier cas "LARGEUR"?

J,espère que c'est clair.

merci

Bonsoir

A tester

Sub Macro1()
Dim Depart As String

  Application.ScreenUpdating = False
  Range("a1").Select

  Cells.Find(What:="largeur", After:=ActiveCell, LookIn:=xlFormulas, _
            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
            MatchCase:=False, SearchFormat:=False).Activate
  Depart = ActiveCell.Address
  ActiveCell.Offset(0, 1).Copy

  Do
    Cells.Find(What:="LONGUEUR", After:=ActiveCell, LookIn:=xlFormulas, _
              LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
              MatchCase:=False, SearchFormat:=False).Activate
    ActiveSheet.Paste ActiveCell.Offset(0, 2)

    Cells.Find(What:="LARGEUR", After:=ActiveCell, LookIn:=xlFormulas, _
              LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
              MatchCase:=False, SearchFormat:=False).Activate
    ActiveCell.Offset(0, 1).Copy
  Loop While ActiveCell.Address <> Depart
  Application.CutCopyMode = False
  Range("A1").Select
End Sub

Merci, ça fonctionne très bien.