Copier coller avec condition

Bonjour au forum,

Dans le fichier joint, je fais un copier de la feuil1 toutes les lignes à partir de la ligne 10 jusqu'à la dernière ligne remplie si les valeurs de la colonne Q sont égales à B2, je veux le coller sur la feuil3 en A10.

Idem pour les lignes de la feuil2 vers le feuil4.

Le code ci-dessous me fait le coller en A2

Merci

Voici le code

Sub copier()

Dim fd, fd1, f, i, lgn

Set fd = Sheets("Feuil1")

Sheets("Feuil1").Select

'Initialisation

For i = 1 To 2

f = Choose(i, "Feuil3", "Feuil4")

Sheets(f).Range("A1").CurrentRegion.Offset(2, 0).Clear

Next i

For i = 2 To fd.Range("A" & 65536).End(xlUp).Row

If fd.Range("Q" & i).Value = Range("A2").Value Then

lgn = Sheets("Feuil3").Range("A" & 65536).End(xlUp)(2).Row

fd.Range("A" & i & ":G" & i).Copy Sheets("Feuil3").Range("A" & lgn)

End If

Next i

'Initialisation

Set fd1 = Sheets("Feuil2")

Sheets("Feuil2").Select

For i = 2 To fd1.Range("A" & 65536).End(xlUp).Row

If fd1.Range("Q" & i).Value = Range("A2").Value Then

lgn = Sheets("Feuil4").Range("A" & 65536).End(xlUp)(2).Row

fd1.Range("A" & i & ":G" & i).Copy Sheets("Feuil4").Range("A" & lgn)

End If

Next i

End Sub

Rechercher des sujets similaires à "copier coller condition"