copier coller avec condition

[sinjun]

Bonjour,
J'aimerai copier des lignes entières seulement si une des cellules contient la date de formation.
La copie se fera sur un autre onglet en incrémentant ligne par ligne.
Je sais faire la macro le seul problème c'est que j'ai 200 lignes à analyser et je bloque sur la création d'une boucle afin que la macro analyse toutes les lignes et copie seulement celles qu'y ont été renseignées.
j'espère avoir été assez clair, merci d'avance pour votre aide.

 

[sinjun]

voici mon code qui n'est pas beau (je sais mais ce sont mes premiers pas ds le vba)
Sub Suivi_PLF()

'supprime les rafraîchissements d'écran
Application.ScreenUpdating = False

Sheets("Formation").Select
If Range("J3").Value = "" Then
MsgBox "Vous avez oublié de saisir une propostion de date"
End If

' Ligne 1
Sheets("Formation").Select
If Range("J3") <> "" Then

'nom personnel
Range("D13").Select
Selection.Copy
Sheets("Suivi PLF").Select
Range("C30001").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True

'Formation
Sheets("Formation").Select
Range("D4,F4").Select
Range("F4").Activate
Application.CutCopyMode = False
Selection.Copy
Sheets("Suivi PLF").Select
Range("F30001").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'Autres points
Sheets("Formation").Select
Range("G4:K4").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Suivi PLF").Select
Range("J30001").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
end sub
' Ligne 2
Sheets("Formation").Select
If Range("J5") <> "" Then

'nom personnel
Range("D13").Select
Selection.Copy
Sheets("Suivi PLF").Select
Range("C30002").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True

'Formation
Sheets("Formation").Select
Range("D5,F5").Select
Range("F5").Activate
Application.CutCopyMode = False
Selection.Copy
Sheets("Suivi PLF").Select
Range("F30002").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'Autres points
Sheets("Formation").Select
Range("G5:K5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Suivi PLF").Select
Range("J30002").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If

' Ligne 3
Sheets("Formation").Select
If Range("J6") <> "" Then

'nom personnel
Range("D13").Select
Selection.Copy
Sheets("Suivi PLF").Select
Range("C30003").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True

'Formation
Sheets("Formation").Select
Range("D6,F6").Select
Range("F5").Activate
Application.CutCopyMode = False
Selection.Copy
Sheets("Suivi PLF").Select
Range("F30003").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'Autres points
Sheets("Formation").Select
Range("G6:K6").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Suivi PLF").Select
Range("J30003").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
'Faire les autres lignes

'tri
Sheets("Suivi PLF").Select
Range("C2:AA30100").Select
Application.CutCopyMode = False
Selection.Sort Key1:=Range("C2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("C5").Select

'Efface
Sheets("Formation").Select
Range("D1,F4:K44").Select
Range("F4").Activate
Application.CutCopyMode = False
Selection.ClearContents
Range("D1").Select


End Sub

 

[zeb]

Salut,

Alors d'abord, intervention du modérateur : conformément au règlement, il faut mettre au début de chaque pièce de code de VB la balise [code=vb] et à la fin, la balise [/code].

Pour éditer ton message, clique sur l'un des boutons représentant un crayon en bas de chaque message.
[:zeb:4]

-------------------------------------

Ensuite, je te conseille de lire quelques unes de mes contributions sur ce site. Environ 90% d'entre elles traitent de ce sujet ! (si, si, c'est vrai).

En gros, et pour résumer :

1°) S'il y a plus d'un Select dans tout ton code, c'est qu'il faut tout revoir.
2°) S'il y a un Selection qui suit un Select, c'est qu'il faut les supprimer tous les deux.
3°) S'il y a la moindre utilisation du presse-papier comme zone de mémoire temporaire, c'est qu'il faut aller relire la page de manuel de la fonction utilisée pour ne plus le faire (c'est mal).

Et quand on a fait tout ça, comme par magie, la boucle pour traiter les 200 lignes devient évidente.
(D'autant qu'on sera là pour te guider )

 

[sinjun]

Après correction mon code a maigris
vb

Dim Lg&, i%
Application.ScreenUpdating = False
Sheets("Formation").Activate
'Lg = Range("A" & Rows.Count).End(xlUp).Row
Lg = Range("A3:j250").End(xlDown).Row
For i = 3 To Lg
Range("A" & i).Resize(1, 10).Copy 'nb de colonnes selectionnées
With Sheets("suivi PLF")
.Range("B65536").End(xlUp)(2).PasteSpecial Paste:=xlPasteValues, Transpose:=False
End With
Application.CutCopyMode = False
Next i

Par contre je n'arrive toujours pas a rajouter ma condition if pour ne copier QUE les lignes qui ont la colonne 10 de rempli(format date)

autre question:
j'ai anticiper sur une evolution du nombre de lignes, le problème quand on lance la macro plusieurs fois, les cellules vides sont intercalées avec les autres, comment je peux faire pour les annuler a part par la fonction tri.
Merci.

 

[zeb]

Mais si tu ne respectes pas le règlement, tu ne trouveras pas de solution ici.

 

[sinjun]

Mais si tu ne respectes pas le règlement, tu ne trouveras pas de solution ici.