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
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