Copier coller selon un critère

Bonjour. J'ai écrit un code en langage VBA qui copie une ligne qui contient une cellule dont la valeur est supérieure à un quantité donnée. Mon problème est que dans la feuille réceptacle (ws_2), seule la dernière ligne est collée ( quand celle-ci répond au critère).

Sub copier_coller()
Dim i as long 
Dim ws_1, ws_2 as worksheet
Dim der_ligne, lastRow  as long

Set ws_1= Worksheets(1)
Set ws_2 = Worksheets(2)
der_ligne = ws_1.Cells(Rows.count, 1).End(xlUp).Row
lastRow = ws_2.Cells(Rows.count, 1).End(xlUp).Row + 1

For i = 2 To der_ligne
    if Cells(i, 3).Value >=10 Then
        ws_1.Rows(i).Copy  ws_2.Rows(lastRow)
    End if
Next i

End sub 

Merci

Bonjour LeMANIMAK,

(lastRow) est la dernière cellule "non-vide".

Pour écrire au bas de la liste, ajoute "+1"

For i = 2 To der_ligne
    if Cells(i, 3).Value >=10 Then
        ws_1.Rows(i).Copy  ws_2.Rows(lastRow) + 1  ' <ajout Bizz
    End if
Next i

Bizz

Le programme copie et colle bien à la suite de la dernière ligne non vide, mais ne colle uniquement que la dernière ligne de la Feuille1(ws_1)

Bonjour LeMANIMAK,

Ceci fonctionne :

Sub copier_coller()
Dim i As Long
Dim ws_1, ws_2 As Worksheet
Dim der_ligne, lastRow  As Long

Set ws_1 = Worksheets(1)
Set ws_2 = Worksheets(2)
der_ligne = ws_1.Cells(Rows.Count, 1).End(xlUp).Row
lastRow = ws_2.Cells(Rows.Count, 1).End(xlUp).Row + 1

For i = 2 To der_ligne
    If Cells(i, 3).Value >= 10 Then
        ws_1.Rows(i).Copy ws_2.Rows(lastRow)
        lastRow = lastRow + 1
    End If
Next i

End Sub

Bizz

Bonsoir bizarre. C'est propre et encore merci...