XL 2013 Couper/Coller des lignes sur une autre feuille suivant condition

[Packers#12]

Bonjour à tous !

Je débute sur VBA et malgré de nombreuses recherches sur le net j'ai pas réussi à trouver la solution qui me conviendrait...

Concernant mon problème :
J'ai un fichier qui me permet de gérer l'avancement de mes projets.
Dans ma feuille 1 nommée "Ongoing" et plus précisément dans la colonne A, j'ai une liste déroulante avec notamment une cellule "COM" (quand le projet est complété).
Je souhaiterais que ma macro déplace le ou les projets définis comme "COM" vers ma feuille 2 (nommée "Completed") afin de garder une trace de tous mes projets et d'alléger le visuel de ma feuille 1.

J'ai déjà un bouton qui me permet de copier les lignes passées "COM" de la feuille 1 vers la 2nde mais par la suite lorsque de nouveaux projets passent "COM", ceux-ci écrasent les précédentes lignes de projets déjà mises sur ma feuille 2.
Je n'arrive pas à faire en sorte que les lignes s'additionnent les unes sous les autres sans repartir à chaque fois au début de mon tableau.

Je ne sais pas si c'est bien clair...

Ci-joint mon bout de code initial, qui me permettait de copier/coller les lignes de la feuille 1 à la 2nde et de faire le ménage dans mon tableau 1.

dernligne = Sheets("Ongoing").Range("A" & Rows.Count).End(xlUp).Row
k = 4
For i = 1 To dernligne
If Sheets("Ongoing").Cells(i, 1) = "COM" Then
Sheets("Ongoing").Cells(i, 1).EntireRow.Copy Sheets("Completed").Cells(k, 1)
k = k + 1
End If
Next i

For i = dernligne To 1 Step -1
If Sheets("Ongoing").Cells(i, 1) = "COM" Then
Sheets("Ongoing").Cells(i, 1).EntireRow.Delete
End If
Next i

End Sub

D'avance merci pour votre aide.

 

[Robert]

Bonjour Packers, bonjour le forum,

Peut-être comme ça :

Dim DEST As Range

For i = 1 To dernligne
    If Sheets("Ongoing").Cells(i, 1) = "COM" Then
        If Sheets("Completed").Range("A4") = "" Then
            Set DEST = Sheets("Completed").Range("A4")
        Else
            Set DEST = Sheets("Completed").Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0)
        End If
        Sheets("Ongoing").Cells(i, 1).EntireRow.Copy DEST
    End If
Next i

 

[Packers#12]

Bonjour Robert,

Merci beaucoup pour ton aide précieuse et rapide !
Ca marche parfaitement. 🙂

A une prochaine.
Rémy