Bonjour a tous,
Mon classeur comporte 2 Feuilles. Une feuille "Demande", l'autre "Suivis".
Ma macro compte dans un premier temps le nb de lignes non vide sur la feuille "suivis".
Puis elle cherche des valeurs dans la plage ("E19:E29)
Je souhaite que si une cellule de cette plage n'est pas vide alors cette cellule ainsi que les 3 précedentes de la même ligne soient copier à la suite sur la feuille "Suivis".
Ensuite elle passe à la cellule suivante.
Mon probleme est que la macro copie les dernieres valeurs autant de fois qu'il y a de ligne dans ma plage ("E19:E29) même si la cellule de reference est vide.
Du coups je me retouve avec des doublons.
C'est comme si elle ne prenait pas en compte le IF.
Je joint le fichier en question.
Par avance, merci pour votre aide.
Mon classeur comporte 2 Feuilles. Une feuille "Demande", l'autre "Suivis".
Ma macro compte dans un premier temps le nb de lignes non vide sur la feuille "suivis".
Puis elle cherche des valeurs dans la plage ("E19:E29)
Je souhaite que si une cellule de cette plage n'est pas vide alors cette cellule ainsi que les 3 précedentes de la même ligne soient copier à la suite sur la feuille "Suivis".
Ensuite elle passe à la cellule suivante.
Mon probleme est que la macro copie les dernieres valeurs autant de fois qu'il y a de ligne dans ma plage ("E19:E29) même si la cellule de reference est vide.
Du coups je me retouve avec des doublons.
C'est comme si elle ne prenait pas en compte le IF.
Je joint le fichier en question.
Par avance, merci pour votre aide.
Code:
Sub Suivis()
'
' Suivis Macro
'
'
Dim AjoutSuppr
Dim NumLigne
NumLigne = ActiveCell.Row
F_destination = "Suivis" 'Feuille de destination pour la copie
Sheets("Suivis").Select 'Selection de la feuille "Suivis"
'Determine le nb de ligne non vide dans la feuille "Suivis"
nb = 0
For Each lig In ActiveSheet.UsedRange.Rows
If Application.CountA(lig) > 0 Then nb = nb + 1
Next
Sheets("Demande").Select 'Selection de la feuille "Demande"
'Boucle sur selection, recherche de valeur et copie dans une seconde feuille
Set AjoutSuppr = ActiveSheet.Range("E19:E29")
i = nb + 1
For Each Cell In AjoutSuppr
If Cell.Value <> "" Then Cell.Select
i = i + 1: Cells(2, 10).Value = nb
Range("B" & ActiveCell.Row & ":E" & ActiveCell.Row).Copy (Sheets(F_destination).Range("A" & i))
Range("E5").Copy (Sheets(F_destination).Range("E" & i)) 'copie la date du jour qui est en E5
Next Cell
'Suppression du format des colonnes ABCD
Sheets("Suivis").Select
Columns("A:D").Select
Selection.ClearFormats
End Sub