Simplifier un code VBA fait avec l'enregistreur de

Résolu/Fermé
Bourrique66 Messages postés 158 Date d'inscription mardi 2 juin 2015 Statut Membre Dernière intervention 25 septembre 2023 - 3 avril 2018 à 18:11
via55 Messages postés 14405 Date d'inscription mercredi 16 janvier 2013 Statut Membre Dernière intervention 25 avril 2024 - 4 avril 2018 à 20:59
Bonjour,
Actuellement, j'utilise une macro faite avec l’enregistreur de macro qui copie une liste qui se trouve sur la feuille BDDG, dans les colonnes A , C, D, E et F. Cette macro colle ensuite les données sur une autre feuille nommée Fréquence des chene. Je trouve que lors de l’exécution de la macro ce n’est pas très fluide malgré que j’ai mis : Application.ScreenUpdating = False au début de la macro et Application.ScreenUpdating = True à la fin. Du coup, je me demande si faudrait pas simplifier ce code, personnellement je suis incapable de le faire. Du coup, je me tourne vers vous pour une solution.
Merci d’avance pour votre aide.
Je joins un fichier de démonstration.
A voir également:

8 réponses

via55 Messages postés 14405 Date d'inscription mercredi 16 janvier 2013 Statut Membre Dernière intervention 25 avril 2024 2 703
3 avril 2018 à 18:14
Bonjour

Où est le fichier ?
Le poster sur mon-partage.fr, faire créer un lien, le copier et revenir le coller ici

Cdlmnt
Via
0
Bourrique66 Messages postés 158 Date d'inscription mardi 2 juin 2015 Statut Membre Dernière intervention 25 septembre 2023 2
3 avril 2018 à 19:09
Re bonjour
Un oubli de ma part
https://www.cjoint.com/data/HDdrhfu2YS0_Pour-essai.xlsm
0
via55 Messages postés 14405 Date d'inscription mercredi 16 janvier 2013 Statut Membre Dernière intervention 25 avril 2024 2 703
3 avril 2018 à 19:47
Re

1) om ùe semble que ta macro peut déjà se simplifier ainsi :
Sub Maj_des_Listes()
Application.ScreenUpdating = False

' Maj_des_Listes Macro
'

'
    Sheets("BDDG").Select
    Range("A2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Fréquence des chene").Select
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("BDDG").Select
    Range("C2:F2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Fréquence des chene").Select
    Range("B2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Application.ScreenUpdating = True

End Sub

puisqu'à part la 1ere les colonnes se suivent et que les dernière lignes
 Sheets("BDDG").Select
    Range("TblBDDG[[#Headers],[Ail]]").Select
    Application.CutCopyMode = False
    Sheets("Fréquence des chene").Select
    Range("R1").Select

ne semblent servir à rien

2) Bien qu'il y ait l'instruction Application.ScreenUpdating = False le passage d'une feuille sur l'autre occasionne l'effet visuel désagréable
Pour l'éviter on peut remplacer les copier coller par une boucle copiant toutes les cellules une par une sans aller retour entre les feuilles, à condition que la liste ne soit pas trop longue au cas où l'opération prendra un peu de temps
Macro avec boucle :
Sub Maj_des_Listes2()
Dim Ligne As Long
Dim n As Integer
Application.ScreenUpdating = False
Ligne = Sheets("BDDG").Columns(1).Find("*", , , , xlByColumns, xlPrevious).Row
For n = 2 To Ligne
 Sheets("Fréquence des chene").Range("A" & n) = Sheets("BDDG").Range("A" & n)
  Sheets("Fréquence des chene").Range("B" & n) = Sheets("BDDG").Range("C" & n)
   Sheets("Fréquence des chene").Range("C" & n) = Sheets("BDDG").Range("D" & n)
    Sheets("Fréquence des chene").Range("D" & n) = Sheets("BDDG").Range("E" & n)
     Sheets("Fréquence des chene").Range("E" & n) = Sheets("BDDG").Range("F" & n)
     Next
   Application.ScreenUpdating = True
    Sheets("Fréquence des chene").Select
End Sub


Cdlmnt
Via
0
michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 303
4 avril 2018 à 10:07
Bonjour Bourrique, Via

2 petits Trucs:
1/ Contrairement à ce que l'on pense, il est inutile de remettre screenupdating à true à la fin de la macro,
la macro rendant la main au systeme, cette instruction interne à la procédure s'éteint (source: Laurent Longre)
2/
Ligne = Sheets("BDDG").Columns(1).Find("*", , , , xlByColumns, xlPrevious).Row
renvoie à la ligne 1603 (inscription dans cette cellule !)

peut-^tre utiliser la première ligne vide -1
Columns("A").Find(what:="", after:=Range("A1")).Row - 1
0
Bourrique66 Messages postés 158 Date d'inscription mardi 2 juin 2015 Statut Membre Dernière intervention 25 septembre 2023 2
4 avril 2018 à 19:57
Bonjour,
Merci à via55 pour cette réponse aussi rapide à la demande de modification de code. Je viens de le tester et bien entendu c’est parfait. Cependant, je viens de m’apercevoir d’un problème que je n’avais pas décelé. En effet lorsque je rentre une nouvelle donnée dans la « BDDG » et que je fais la mise à jour des listes tout marche nickel, mais si je supprime cette même donnée dans « BDDG » et que je refais une mise à jour des listes la ligne n’est pas supprimée dans « Fréquence des chene ». Si un code Vba pouvez remédier à cela se serait la cerise sur le gâteau, sinon ce n’est pas grave je le ferais manuellement.
Encore merci pour votre réactivité


https://www.cjoint.com/c/HDer3pdBtK0
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
via55 Messages postés 14405 Date d'inscription mercredi 16 janvier 2013 Statut Membre Dernière intervention 25 avril 2024 2 703
4 avril 2018 à 20:29
Bonjour

Rajoute cette ligne dans la macro juste avant le For
Sheets("Fréquence des chene").Range("A2:E1000").ClearContents

Elle efface la plage A2:E1000
A modifier si tu as plus de lignes

Cdlmnt
Via
0
Bourrique66 Messages postés 158 Date d'inscription mardi 2 juin 2015 Statut Membre Dernière intervention 25 septembre 2023 2
4 avril 2018 à 20:36
Bonsoir,
Vraiment trop trop fort ça marche comme il faut, c'est parfait je vais pouvoir continuer mon projet et encore merci.
0
Bourrique66 Messages postés 158 Date d'inscription mardi 2 juin 2015 Statut Membre Dernière intervention 25 septembre 2023 2
4 avril 2018 à 20:37
comment marquer résolu?
0
via55 Messages postés 14405 Date d'inscription mercredi 16 janvier 2013 Statut Membre Dernière intervention 25 avril 2024 2 703
4 avril 2018 à 20:59
L’icône triangle avec ! tout en haut à droite
Bonne suite ☺
0