Faire une boucle avec .find

Bonsoir a tous et merci pour votre aide

je n'arrive pas a faire une boucle en VBA et j'aurais besoin de votre aide.

voici mon code qui marche pour une ligne mais je souhaiterai faire la boucle sur l ensemble des lignes et non pas sur une seule ligne comme dans mon code :

 Dim cell_nom_CMR As Range, lg_CMR As Integer
Set cell_nom_CMR = Columns("K").Find("CMR", , , , , xlPrevious)
lg_CMR = Columns("K").Find(cell_nom_CMR).Row

MsgBox "le cmr est en cellule" & lg_CMR

Worksheets("recap").Range(Cells(lg_CMR, 10), Cells(lg_CMR, 23)).Copy
 Worksheets("Feuil1").Cells(12, 1).PasteSpecial Paste:=xlPasteValues

en fait avec mon code je trouve le mot CMR et je copie la ligne de la colone 10 à 23 mais ce que je souhaiterai faire c'est faire l'analyse du mot CMR sur toute la colonne K et a chaque fois que CMR est trouvé alors la ligne est copiée.

Merci pour votre aide vraiment

Bonjour et bienvenu(e)

A tester

Sub test()
Dim cell_nom_CMR As Range, lg_CMR As Integer
Dim Depart As String

  Set cell_nom_CMR = Columns("K").Find("CMR", , , , , xlPrevious)
  If Not cell_nom_CMR Is Nothing Then
    Depart = cell_nom_CMR.Address
    Do
      MsgBox "le cmr est en cellule" & lg_CMR
      lg_CMR = cell_nom_CMR.Row
      Worksheets("recap").Range(Cells(lg_CMR, 10), Cells(lg_CMR, 23)).Copy
      Worksheets("Feuil1").Cells(12, 1).PasteSpecial Paste:=xlPasteValues
      Set cell_nom_CMR = Columns("K").FindNext(cell_nom_CMR)
    Loop While Depart <> cell_nom_CMR.Address
  End If
End Sub

Mais ne pas oublier d'incrémenter la ligne de recopie sinon toutes les lignes trouvées seront copiées au même endroit

merci beaucoup!!

mais quand je veut l'incrementer comme vous m avez preconniser a ce niveau la ca bug :

Worksheets("Feuil1").Cells(12, 1).PasteSpecial Paste:=xlPasteValues

Sub test()
Dim cell_nom_CMR As Range, lg_CMR As Integer
Dim Depart As String

  Set cell_nom_CMR = Columns("K").Find("CMR", , , , , xlPrevious)
for i=1 to 50 
 If Not cell_nom_CMR Is Nothing Then
    Depart = cell_nom_CMR.Address
    Do
      MsgBox "le cmr est en cellule" & lg_CMR
      lg_CMR = cell_nom_CMR.Row
      Worksheets("recap").Range(Cells(lg_CMR, 10), Cells(lg_CMR, 23)).Copy
      Worksheets("Feuil1").Cells(12 + i, 1).PasteSpecial Paste:=xlPasteValues
      Set cell_nom_CMR = Columns("K").FindNext(cell_nom_CMR)
    Loop While Depart <> cell_nom_CMR.Address
  End If
next i
End Sub

pourriez m'aider a resoudre mon probleme d incrementation?

merci bonne soirée

Bonsoir

Essaie comme ceci

Sub test()
Dim cell_nom_CMR As Range, lg_CMR As Integer
Dim Depart As String, I As Integer

  Set cell_nom_CMR = Columns("K").Find("CMR", , , , , xlPrevious)
  If Not cell_nom_CMR Is Nothing Then
    Depart = cell_nom_CMR.Address
    Do
      MsgBox "le cmr est en cellule" & lg_CMR
      lg_CMR = cell_nom_CMR.Row
      Worksheets("recap").Range(Cells(lg_CMR, 10), Cells(lg_CMR, 23)).Copy
      Worksheets("Feuil1").Cells(12 + I, 1).PasteSpecial Paste:=xlPasteValues
      I = I + 1
      Set cell_nom_CMR = Columns("K").FindNext(cell_nom_CMR)
    Loop While Depart <> cell_nom_CMR.Address
  End If
End Sub

Super cela marche tres bien!!

et si je souhaite copier en :

Worksheets("Feuil1").Cells(12 + I + P, 1).PasteSpecial Paste:=xlPasteValues

tout ce qui n'est pas reconnu en "CMR" , comment dois ecrire mon code?

cordialement

Bonsoir

Il faut changer de code car la fonction Find() ne cherche que ce que l'on veut mais ne cherche pas ce que l'on ne veut pas

Fournis un fichier avec un exemple de résultat et on va essayer de trouver une solution

Bonsoir et merci pour vos reponses!

Changer completement de code aie aie....

Pourriez vous m aider un peu car je suis debutant en vba...

Faudrait pouvoir copier qd CMR est reconnu et tt ce qui n est pas reconnu le copier ailleurs..

Merci bcq pour votre aide precieuse

Cdlt

Bonjour et bonne année,

Merci de joindre un fichier représentatif.

Cdlt.

voici le fichier !

et encore merci

Bonjour

A tester

Merci pour aide !! c est genial!

bonne soirée