Probleme de copie de cellule vers autre feuille

[freyer]

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.

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

 

[Dugenou]

Re : Probleme de copie de cellule vers autre feuille

Bonjour,
Je pense, mais je peux me tromper, que la cell.value d'une cellule vide est 0 et non ""

Cordialement

 

[freyer]

Re : Probleme de copie de cellule vers autre feuille

Bonjour Dugenou,

Merci pour ta réponse.
En fait, après avoir essayé, "" ou 0 on le même resultat.

Cordialement

 

[Dugenou]

Re : Probleme de copie de cellule vers autre feuille

Deuxieme tentative
et cette fois ci ça marche : le texte apres le if sur la même ligne est celui qui s'applique si vrai
ce qui est en dessous s'applique si faux
corrigé ainsi :

            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
                End If
                
            Next Cell

donne bien 3 lignes
Cordialement

 

[freyer]

Re : Probleme de copie de cellule vers autre feuille

Alors là, je dis bravo !!

J'avais bien essayé le End If mais le fait que Cell.select ne retournait pas a la ligne me causait une erreur.

en tout cas ça marche !!!

Merci beaucoup.

 

[Dugenou]

Re : Probleme de copie de cellule vers autre feuille

Re,
Je suis assez nul en vba mais j'ai au moins retenu ceci : le if..then a deux syntaxes
soit tu mets après le then ce qui s'exécute si vrai et à la ligne ce qui s'exécutesi faux et donc pas de end if
soit tu vas à la ligne après then et là tout ce qui est aprés s'exécute si vrai jusqu'au end if
Cordialement