Copier coller avec condition

[Citaro]

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

 

[Jacky67]

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

Bonjour,
Cette macro fait exactement ce qu'on lui demande

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

Il faudra insérer des lignes vides en haut des feuilles "feuil3 et feuil4" s'il faut commencer en ligne 10
et modifier 'Initialisation'
Ou tester la pj
Ps Les données ne commencent pas a la même ligne dans feuil1 que dans feuil2 dans le classeur joint.

 

[Citaro]

Merci Jacky,
Je n'ai pas réussi à voir cela, c'est peut-être l'effet de la canicule......

Citaro

 

[Jacky67]

Merci Jacky,
Je n'ai pas réussi à voir cela, c'est peut-être l'effet de la canicule......

Citaro

Oui, j'ai dû prendre un coup de chaleur..