Copier coller avec boucle

Bonjour à tous,

J'ai ecris un code qui copie et colle une ligne à conditions que certains critères soit rempli.

Le problème est que lorsqu'une ligne rempli ces critères la macro s'arrete.

J'ai bien une boucle qui recherche pour copier mais je ne sais pas comment ajouter le caractère tant que condition rempli alors...

Il me manque aussi le caractere "passer à la ligne suivante" pour coller les éventuelles autres lignes qui remplissent les critères (offset)

je pense que je dois a la fois intégrer une boucle while wend pour la partie "copie" et une boucle avec offset pour la partie "collage"

Le fichier source peut contenir jusqu'à 2000 lignes.

je voudrais que la macro puisse chercher dans Feuil2 les lignes qui sont datées de la date du jour (colonne B) et qui ont un montant = 0 (colonne C)et coller les lignes qui repondent aux critères l'une en dessous de l'autre dans la Feuil1.

Merci d'avance pour votre aide !

Tarik

Bonjour,

Si tu avais mis dans ton exemple la macro que tu avais élaboré,

Un membre ou moi-même pourrait de dire où il y a le problème

Car là, c'est fais-moi le code

Hello M12,

Je suis frustré car je sais qu'il me faut juste ajouter le critere while ou Do while, et ajouter l'option "end" et offset pour que cela finctionne.

J'ai bien essayé de regler la problème tout seul pour mon amour propre mais apres 10 jours de recherches et d'essaies infructueux j'abdique avec douleur et amertume

mon code en pj...

Merci

Tarik

Bonjour,

il n'y a pas de code VBA dans un XLS ...

P.

Bonjour

Place ceci dans un module et teste

Sub test()
Dim F1 As Range
Dim i As Integer
Dim j As Integer
Dim DernLigne As Long
DernLigne = Sheets("Feuil2").Range("A" & Rows.Count).End(xlUp).Row
Set F1 = Sheets("Feuil2").Range("A1:A" & DernLigne)
j = 1
Sheets("Feuil1").Range("A1:C" & DernLigne).Clear
    For i = 1 To F1.Rows.Count
      If F1(i, 2).Value = Date And F1(i, 3).Value = 0 Then
        Sheets("Feuil1").Cells(j, 1) = F1(i, 1).Value
        Sheets("Feuil1").Cells(j, 2) = F1(i, 2).Value
        Sheets("Feuil1").Cells(j, 3) = F1(i, 3).Value
        j = j + 1
      End If
    Next i
End Sub

Salut M12,

Merci j'essaie le code de suite.

Je pense que je vais devoir l'adapter car le nombre de lignes repondant aux criteres n'est surement pas limité à 3, il peut varier de 0 à n

en pj le bon fichier format xlsm AVEC mon modeste code...

Re,

Le Nb de lignes n'est pas limité à 3 ,

Teste en mettant toutes les dates à celle du jour et avec des chiffres 0 en col C et teste

Je teste et te tien au courant

Hello M12

Ca marche très bien, aussi bien en faisant en sorte que toutes les lignes repondent aux critère que lorsqu'aucune lignes ne reponds aux criteres.

Sinon est-il indispensable d'avoir ces 3 lignes ?

Sheets("Feuil1").Cells(j, 1) = F1(i, 1).Value

Sheets("Feuil1").Cells(j, 2) = F1(i, 2).Value

Sheets("Feuil1").Cells(j, 3) = F1(i, 3).Value

Une seule ne suffirait pas ? si oui comment puis-je la rediger s'il te plait ?

Peux-tu m'éclairer sur For i = 1 To F1.Rows.Count

.Rows.Count signifie jusqu'à derniere ligne n'est-ce pas ?

Merci !

Tarik

Hello M12,

comme ces lignes me turlupinait un peu j'ai essayé ça et ça a marché

Sheets("Feuil1").Cells(j, 1) = F1(i, 1).Value

Sheets("Feuil1").Cells(j, 2) = F1(i, 2).Value

Sheets("Feuil1").Cells(j, 3) = F1(i, 3).Value

If F1.Range("b" & i) = Date And F1.Range("C" & i) = 0 Then

Range("A" & i & ":C" & i).Copy

Sheets("Feuil1").Range("A" & j & ":C" & j).PasteSpecial

un grand merci pour ton grand coup de pouce M12