Aide VB Excel, problème copie de lignes avec conditionsRésolu

Question

Bonjour à tous ! 


Voilà j'ai posté il y a quelque temps pour avoir de l'aide sur une macro Excel VB qui avait pour but de copier toute les lignes d'une feuille d'un autre classeur, ici test2.xls vers le classeur ouvert à ce moment.
Cette macro marche très bien, c'est celle-ci :





Sub test()


Dim F_S As Worksheet 'Feuille source
Dim F_D As Worksheet 'Feuille Destination
Dim Lig_S As Long 'Ligne source
Dim Lig_D As Long 'Ligne destination
Dim ClasseurPrincipal As Workbook 'Classeur destination
Dim NomClasseur As Workbook 'Classeur source



'Memorise le classeur destination

Set ClasseurPrincipal = ActiveWorkbook
'Ouvre le classeur source
Set NomClasseur = Application.Workbooks.Open("C:	est2.xls")





'Définition des feuilles

Set F_D = ClasseurPrincipal.Sheets("Feuil1") 'feuille destination
Set F_S = NomClasseur.Sheets("Feuil1")  'feuille source





'définition des lignes

Lig_D = F_D.Range("A65536").End(xlUp).Row + 1
'Ligne destination est la première de G vide



'Programme *****************************************

    For Lig_S = F_S.Range("A65536").End(xlUp).Row To 4 Step -1
    'Pour Ligne source = dernière non vide en A jusqu'à la ligne 4
    'en passant à la ligne précédente par décrémentation (-1)
        'Quand la valeur est inférieure à 1, on passe à laligne suivant Next Lig_S
        
                    F_S.Rows(Lig_S).Copy Destination:=F_D.Rows(Lig_D)
                    'on copie la ligne source sur la ligne destination
                    Lig_D = Lig_D + 1
                    'on passe à la ligne destination suivante
                    
                
        
    Next Lig_S
    'Retour à l'instruction For Lig_S...
    
NomClasseur.Close
'On ferme le classeur source


    
    
Range("A2").Select
Selection.AutoFilter
'On applique le filtre automatique


 


MsgBox ("Fin de transfert")
'on avertit que c'est fini



End Sub


 


Je désire implanter une autre fonctionnalité, en faisant le chemin inverse, c'est à dire copier les lignes du classeur ouvert(il ne s'agit pas du même, mais d'un autre ayant exactement la même structure), selon des conditions, vers le fichier test2.xls.


Il me faut donc faire 3 choses sur la classeur source avant de copier la ligne vers le classeur destination.


_Récupérer la date du jour, car ne seront copiées que les lignes saisies le jour même.
_Récupérer la date de l'entrée de chaque ligne pour comparer avec la date du jour, il s'agit des cellules de la colonne A.
_Récupéré le numéro d'agent, car ne seront récupérées que les lignes du jour de cet agent, il s'agit des cellules de la colonne F.


Une ligne ne sera donc copiée qu'à deux conditions, qu'elle corresponde à la date du jour et à un numéro d'agent donné.




J'ai repris le même code que plus haut et je l'ai modifié :


 



Sub testentree()


Dim F_S As Worksheet 'Feuille source
Dim F_D As Worksheet 'Feuille Destination
Dim Lig_S As Long 'Ligne source
Dim Lig_D As Long 'Ligne destination
Dim ClasseurPrincipal As Workbook 'Classeur destination
Dim NomClasseur As Workbook 'Classeur source
Dim date1 As Date 'date récupérée dans le tableau
Dim today As Date 'date du jour
Dim NoAgent As Integer 'numéro d agent





'Memorise le classeur destination

Set ClasseurPrincipal = ActiveWorkbook
'Ouvre le classeur source
Set NomClasseur = Application.Workbooks.Open("C:	est2.xls")





'Définition des feuilles
Set F_S = ClasseurPrincipal.Sheets("Feuil1") 'feuille source
Set F_D = NomClasseur.Sheets("Feuil1")  'feuille destination



'Récupère la date du jour sur la cellule A1

F_S.Activate
F_S.Range("A1").Select
today = ActiveCell.Value


 



'définition des lignes
Lig_D = F_D.Range("A65536").End(xlUp).Row + 1
'Ligne destination est la première de G vide



'Programme *****************************************

    For Lig_S = F_S.Range("A65536").End(xlUp).Row To 4 Step -1
    'Pour Ligne source = dernière non vide en A jusqu'à la ligne 4
    'en passant à la ligne précédente par décrémentation (-1)
        'Quand la valeur est inférieure à 1, on passe à laligne suivant Next Lig_S
        
        
        ActiveCell.Select
        date1 = ActiveCell.Value
        'On récupère la date sur la feuille source dans la colonne A
        ActiveCell.Offset(0, 5).Activate
        ActiveCell.Select
        'On se déplace de 5 cellules à droite, soit colonne F
        NoAgent = ActiveCell.Value
        'On récupère le numéro d'agent dans cette cellule
        ActiveCell.Offset(0, -5).Activate
        'On revient à la colonne A
        
                    If date1 today And NoAgent 969 Then
            'Si la date est celle d'aujourd'hui et le numéro d'agent est égal à 969
            
                    F_S.Rows(Lig_S).Copy Destination:=F_D.Rows(Lig_D)
                    'on copie la ligne source sur la ligne destination
                    Lig_D = Lig_D + 1
                    'on passe à la ligne destination suivante
                    
            Else
            
                     Lig_D = Lig_D + 1
                     'on passe à la ligne destination suivante
                     
            End If
            
                     
        
    Next Lig_S
    'Retour à l'instruction For Lig_S...
    


    


MsgBox ("Fin de transfert" & Chr(13) & date1 & Chr(13) & today & Chr(13) & NoAgent)
'on avertit que c'est fini
'On affiche les valeurs des différentes variables pour contrôle



End Sub




Mais voilà ça ne marche pas, la copie se fait bien dans le bon sens sans conditions "if". Mais tel quel ça ne marche pas. 
La récupération de la date du jour "today" est bonne, dans le message box à la fin elle correspond bien.
La date récupérée "date1" est la même que celle du jour.
La valeur de la variable "NoAgent" est 0 dans le message box à la fin.


Si je supprime la condition "And NoAgent = 969" il copie toutes les lignes de la feuille source sans prendre en compte la date.


J'ai l'impression que la manière dont je veux récupérer "date1" et "NoAgent" n'est pas bonne car la manière que j'ai faite suppose qu'il est au début qu'il parcourt dans la colonne A.


Mais voilà je ne sais pas comment faire pour être sûr qu'à chaque ligne il aille bien récupérer la valeur de la colonne A (date1) et de la colonne F (NoAgent) de chaque ligne.


Ou alors cette méthode n'est pas bonne pour réaliser ce que je veux ? 

Je précise qu'évidemment toute les feuilles ont la même structure avec le même tableau.




Merci d'avance de votre aide.

domsig · Accepted Answer

eh j'viens d'voir un truc !
dans le code il y a
F_S.Range("A1").Select

et en-dessous tu fais

 For Lig_S = F_S.Range("A65536").End(xlUp).Row To 4 Step -1      
        ActiveCell.Select

c'est toujours ta cellule A1 qui est sélectionnée ; il faudrait que tu fasses un truc du style
activesheets.cells(Lig_S,1).select

enfin je pense

Allez voir mon site !
http://www.amis-marolles.org
le site d'une association s'occupant de patrimoine et de traditions

domsig · Answer

bonjour

as-tu essayé d'exécuter pas à pas ton code en mettant un point d'arrêt sur la ligneIf date1 today And NoAgent 969 Then...
on dirait qu'il y aurait quelque chose à ce niveau-là ?

ps : sinon tu peux peut-être simplifier ton code, à la place du offset pour te déplacer d'une cellule à l'autre tu peux récupérer sa valeur directement en faisant variable=activesheets.cells(ligne,colonne).value (ou quelque chose comme ça, mais c'est toi qui vois !)

Allez voir mon site !
http://www.amis-marolles.org
le site d'une association s'occupant de patrimoine et de traditions

cs_orangeroad · Answer

Bonjour,

Effectivement il serait intéressant de mettre un point d'arrêt à ce moment, mais comment faire ? 

Je veux bien simplifier la récupération des valeurs des deux variables, mais le problème c'est que si je sais dans quelles colonnes elles se trouvent, A et F, dans la boucle je ne sais pas dans quelle ligne elle va se trouver à chaque fois.
La boucle parcoure la feuille depuis la fin jusqu'au début et lorsqu'elle trouve la première ligne non vide, elle la copie puis remonte d'une ligne jusqu'à la ligne 4.

C'est justement là mon problème, je ne sais pas comment récupérer les deux valeurs des variables pour chaque ligne parcourue. 
Ce que j'ai mis en place ne marche pas.

jmfmarques · Answer

Je ne sais pas, mais si tu ne fais qu'une messagebox, à la fin, tu risques fort de ne rien voir du tout de ce qui s'est passé (il suffit par exemple que tu tombes, à la fin, sur une cellule NoAgent vide.

Une suggestion, si tu veux y voir clair syr ce qui a pu se passer tout le long :

Une  listbox (c'est toujours plus confortable à dérouler ensuite) que tu alimentes tout au long de ta boucle et que tu regardes ensuite tranquillement

mets-y par la methode additem, à chaque itération de la boucle, le n° de ta ligne, Date1 et noagent, chaque élément étant séâré de l'autre par la chaîne " = = =  " (pour y voir mieux clair)

puis examine tranquillement cette listebox. Cet examen devrait probablement t'éclairer confortablement.

cs_orangeroad · Answer

J'utilise la listbox comme une msgbox ?

Pour y ajouter des valeurs avec la commande additem il faut les mettres dans une variables ?

Désolé mais je suis débutant en commandes VB.

cs_orangeroad · Answer

Bon j'ai fait un pas à pas détaillé avec F8, il en résulte que tout le long de la ligne le curseur reste à la ligne 1 et revient sans cesse en cellule A1.

Apparament la boucle que j'utilise permet de parcourir la feuille de la fin jusqu'au début, mais le curseur lui ne suit pas le même mouvement.

J'ai bien pensé à mettre le curseur à la fin de la feuille, c'est à dire ligne 65536 et le faire remonter d'une ligne à chaque fois, mais la boucle commençant automatiquement à la première ligne non vide en remontant à partir du bas, je ne vois pas comment récupérer cette information dans la boucle. 

Du coup je me demande si avec cette boucle il est possible de faire ce que je veux.
Ou alors si quelqu'un sait comment récupérer dans la boucle le numéro de la première ligne non vide, dans ce cas il me suffirait de faire remonter le curseur d'une ligne à chaque fois.

jmfmarques · Answer

Je vois ...

Voilà un exemple d'incrémentation d'une listbox nommée list1

Private Sub Command1_Click()
   for i = 1 to 10
     list1.additem i
  next
end sub
lances, vois, comprends, puis fais une chose similaire (uniquement la partie en rouge)
      ActiveCell.Select
        date1 = ActiveCell.Value
        'On récupère la date sur la feuille source dans la colonne A
        ActiveCell.Offset(0, 5).Activate
        ActiveCell.Select
        'On se déplace de 5 cellules à droite, soit colonne F
        NoAgent = ActiveCell.Value
        'On récupère le numéro d'agent dans cette cellule
        ActiveCell.Offset(0, -5).Activate
        'On revient à la colonne A
 et       
                    If date1 today And NoAgent 969 Then

en remplaçant i parton_n°_deligne & " " date1 & " " & NoAgent & " === "

bien évidemment, remplace ton_n°_deligne par le code Excel correspondant au n° de ligne ...

lance ensuite : ta listbox se remplira et tu pourras procéder cofortablement à ton examen.

cs_orangeroad · Answer

Merci infiniment, ça marche nickel maintenant !!!

Tu as résoulu mon problème, il fait exactement ce que je voulais maintenant. 

Merci encore pour ton aide, je suis trop content que ça marche !

cs_orangeroad · Answer

Mince ça marche, mais j'ai un petit soucis de ligne vide lors de la copie, et effectivement c'est logique vu la méthode de copie car il remonte la feuille depuis la fin.




Dans l'exemple suivant, on a le fichier source :


*Ligne à ne pas copier
*Ligne à ne pas copier
*Ligne à ne pas copier
*Ligne à ne pas copier
->Ligne à copier
->Ligne à copier




Dans le fichier destination on a :


*Ligne déjà en place
*Ligne déjà en place
*Ligne déjà en place
*Ligne déjà en place
->Ligne copiée
->Ligne copiée


Dans cette configuration aucun souci, pas d'espace.


Par contre dans celle là :




Fichier source :


*Ligne à ne pas copier
*Ligne à ne pas copier
*Ligne à ne pas copier
*Ligne à ne pas copier
->Ligne à copier
->Ligne à copier
*Ligne à ne pas copier
*Ligne à ne pas copier


Fichier destination :


*Ligne déjà en place
*Ligne déjà en place
*Ligne déjà en place
*Ligne déjà en place
Ligne vide
Ligne vide
->Ligne copiée
->Ligne copiée


C'est logique car il a du sauter 2 lignes à ne pas copier avant de trouver 2 lignes à copier.




Vous pensez que c'est possible à résoudre comme problème ?
Car là je ne vois pas trop comment modifier la boucle pour supprimer les lignes vides ou alors ne pas en créer. 


Merci d'avance de votre aide.

cs_orangeroad · Answer

C'est bon j'ai trouvé la solution qui aurait du me sauter aux yeux tout de suite. 

Il suffisait juste de supprimer de la boucle If :
         "
            Else
                     Lig_D = Lig_D + 1
                     'on passe à la ligne destination suivante
         "
                     
Ainsi il ne passe pas à la ligne suivante de la feuille destination s'il n'a pas trouvé de ligne à copier. 

Comme quoi ce sont les solutions les plus simples qui sont parfois les plus difficiles à voir, je cherchais compliqué pour rien. 

Merci en tout cas à ceux qui sont intervenu sur ce topic, sans vous je n'y serais pas arrivé.

Aide VB Excel, problème copie de lignes avec conditions

10 réponses

Votre réponse

Discussions similaires