Accélération macro

Le 20/07/2020 à 09:21

Bonjour,

j'ai écrit une macro qui fonctionne mais le seul problème c'est qu'elle est très lente à l'exécution.

Est ce que qqn pourrait m'aider à l'accélérer?

Merci d'avance

Sub Macro1()

' Macro1 Macro
'
Application.Calculation = xlCalculationManual

    Range("D5").Select
    Sheets("Activité CMO 2020").Select
    Range("Tableau1").Select
    Selection.ListObject.ListRows.Add (1)
    Sheets("Formulaire").Select
    Range("D5").Select
    Selection.Copy
    Sheets("Activité CMO 2020").Select
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Formulaire").Select
    Range("D7").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Activité CMO 2020").Select
    Range("B2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Formulaire").Select
    Range("D9").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Activité CMO 2020").Select
    Range("C2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Formulaire").Select
    Range("D11").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Activité CMO 2020").Select
    Range("D2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Formulaire").Select
    Range("D13").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Activité CMO 2020").Select
    Range("E2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Formulaire").Select
    Range("D15").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Activité CMO 2020").Select
    Range("F2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Formulaire").Select
    Range("D17").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Activité CMO 2020").Select
    Range("G2").Select
    ActiveSheet.Paste
    Sheets("Formulaire").Select
    Range("D19").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Activité CMO 2020").Select
    Range("H2").Select
    ActiveSheet.Paste
    Range("A2:H2").Select
    Application.CutCopyMode = False
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Sheets("Formulaire").Select
    Range("D5").Select
    Selection.ClearContents
    Range("D7").Select
    Selection.ClearContents
    Range("D9").Select
    Selection.ClearContents
    Range("D11").Select
    Selection.ClearContents
    Range("D13").Select
    Selection.ClearContents
    Range("D15").Select
    Selection.ClearContents
    Range("D17").Select
    Selection.ClearContents
    Range("D19").Select
    Selection.ClearContents
    Range("D5").Select

    Application.Calculation = xlCalculationAutomatic

End Sub
Le 20/07/2020 à 09:41

bonjour,

Peut-être quque chose comme ça :

Sub Macro1()
With Sheets("Activité CMO 2020")
   .Range("A2") = Range("D5").Value
   .Range("B2") = Range("D7").Value
   .Range("C2") = SRange("D9").Value
   .Range("D2") = SRange("D11").Value
   .Range("E2") = Range("D13").Value
   .Range("F2") = Range("D15").Value
   .Range("G2") = SRange("D17").Value
   .Range("H2") = Range("D19").Value
End With
Range("D5,D7,D9,D11,D13,D15,D17,D19").ClearContents
End Sub

EDIT : Sinon joindre le fichier

A+

Le 20/07/2020 à 12:03

lorsque je fais votre macro, Excel me dit que Sub Macro1() n'est pas définie

Le 20/07/2020 à 12:39

C'est la seule chose que je n'ai pas modifiée !

A+

Le 20/07/2020 à 13:23
6formulaire.xlsm (28.08 Ko)

Voila le fichier. il faut savoir que la macro s'effectue rapidement ici mais que dans le fichier final il y a bcp de feuilles rattachées

Le 20/07/2020 à 14:50

Bonjour,

N'oublier pas si cela n'est pas déjà fait d'utiliser la fonction Application.ScreenUpdating

Au tout début de votre code

Application.ScreenUpdating = False

Et à la fin de votre code

Application.ScreenUpdating = True

Cela pourrait vous faire gagner un peu de temps

Le 20/07/2020 à 15:37

ScreenUpdating et (CalculationManual) ne sert à rien quand c'est bien fait !

Je te conseille de modifier ton fichier comme le fichier ci joint.

Pour les besoins de la macro j'ai modifié dans le Gestionnaire de Nom le tableau structuré de la feuille Activité :

Il est désormais baptisé "TActiv"

Dans ta feuilles Liste je te conseille de séparer tes différentes Listes par une colonne vide (comme j'ai fait.)

Ensuite tu supprimeras tous les noms de ton Gestionnaire de noms relatifs aux 4 colonnes de cette feuille.

Puis tu créeras des tableaux structurés pour les Médecins, Traitements, Infirmières et Aides et tu les renommeras comme j'ai fait.

Ensuite tu te serviras de ces noms pour ta validation de donnée.

12formulaire-vg.xlsm (28.70 Ko)

A+

Le 20/07/2020 à 15:49

Hello tout le monde,

Galopin01, pourquoi conseilles-tu de séparer les différentes listes par une colonne vide ?

J'avais tendance intuitivement à le faire aussi et puis, ne voyant pas ce que ça changeait dans les faits, j'ai arrêté.

Par avance merci pour ta réponse, et pour les années passées sur les différents forums à éclairer les gens comme moi !

Le 20/07/2020 à 15:59

MERCIII BEAUCOUP !!!

Le 20/07/2020 à 16:28

pourquoi conseilles-tu de séparer les différentes listes par une colonne vide ?

1 Ça permet de les trier sans avoir à se poser de question

2 Pour en faire des tableaux structurés c'est indispensable.

...Mais même si on fait pas de tableaux structurés et que ce sont des listes dynamiques, intuitivement et visuellement c'est quand même plus "parlant" !

A+

Le 22/07/2020 à 16:45

Bonjour à tous,

Merci pour l'info Galopin01 ! (et désolé pour le temps de réponse, je suis passé à côté ...)

Je les crée bien avec une colonne d'espacement mais, des fois, les regroupe ensuite par blocs thématiques. Si au final ça ne change pas grand chose, c'est parfait !

Rechercher des sujets similaires à "acceleration macro"