Code VBA très lent

Bonjour,

J'ai créé un programme excel avec plusieurs macros. Excel exécute le code suivant très très lentement. Serait-il possible d'améliorer ce code pour qu'il l'exécute plus rapidement ?

Sub SaisieDesPrestations11()
'
' SaisieDesPrestations11 Macro
' Enregistre une nouvelle prestation dans le tableau des prestations.
'

'
    ActiveWorkbook.Save
    'Copie du nom du responsable
    Range("B2").Select
    Selection.Copy
    Range("A20").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    'Copie du nom du client
    Range("B9").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("B20").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    'Copie la date du jour
    Range("B7").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("C20").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    'Copie de l'heure du début
    Range("B11").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("D20").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    'Copie l'heure de fin
    Range("C11").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("E20").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    'Copie catégorie comptable
    Range("D9").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("F20").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    'Copie type de prestation
    Range("E9").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("G20").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    'Copie période comptable
    Range("F9").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("H20").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    'Classer le tableau des prestations en fonction de la date, puis l'heure de début, puis par client.
    Range("A20:I8019").Select
    Application.CutCopyMode = False
    ActiveWorkbook.Worksheets("Saisie des prestations").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Saisie des prestations").Sort.SortFields.Add Key:= _
        Range("C21:C8019"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
    ActiveWorkbook.Worksheets("Saisie des prestations").Sort.SortFields.Add Key:= _
        Range("D21:D8019"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
    ActiveWorkbook.Worksheets("Saisie des prestations").Sort.SortFields.Add Key:= _
        Range("B21:B8019"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
        :=xlSortNormal
    With ActiveWorkbook.Worksheets("Saisie des prestations").Sort
        .SetRange Range("A20:I8019")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    'Supprimer les cellules dès qu'elles ont étées rajoutées au tableau.
    Range("B9").Select
    Selection.ClearContents
    Range("B11").Select
    Selection.ClearContents
    Range("C11").Select
    Selection.ClearContents
    Range("D9").Select
    Selection.ClearContents
    Range("E9").Select
    Selection.ClearContents
    Range("F9").Select
    Selection.ClearContents
    Range("A3").Select
    ActiveWorkbook.Save
End Sub

Bonjour,

Sans entrer dans le détail du traitement , tu peux déjà

• supprimer la plupart des sélections.
• désactiver l'actualisation de l'écran
• passer en calcul manuel.

'

    ' SaisieDesPrestations11 Macro
    ' Enregistre une nouvelle prestation dans le tableau des prestations.
    '
        ActiveWorkbook.Save

        Application.ScreenUpdating = False
        Application.Calculation = xlCalculationManual

        Range("B2").Copy 'Copie du nom du responsable

        Range("A20").End(xlDown).Offset(1, 0).Range("A1").PasteSpecial _
        Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

        'Copie du nom du client
        'Application.CutCopyMode = False
        Range("B9").Copy
        Range("B20").End(xlDown).Offset(1, 0).Range("A1").PasteSpecial _
        Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

        'Copie la date du jour
        Range("B7").Copy
        Range("C20").End(xlDown).Offset(1, 0).Range("A1").PasteSpecial _
        Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

        'Copie de l'heure du début
        Range("B11").Copy
        Range("D20").End(xlDown).Offset(1, 0).Range("A1").PasteSpecial _
        Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

        'Copie l'heure de fin
        Range("C11").Copy
        Range("E20").End(xlDown).Offset(1, 0).Range("A1").PasteSpecial _
        Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

        'Copie catégorie comptable
        Range("D9").Copy
        Range("F20").End(xlDown).Offset(1, 0).Range("A1").PasteSpecial _
        Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

        'Copie type de prestation
        Range("E9").Copy
        Range("G20").End(xlDown).Offset(1, 0).Range("A1").PasteSpecial _
        Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

        'Copie période comptable
        Range("F9").Copy
        Range("H20").End(xlDown).Offset(1, 0).Range("A1").PasteSpecial _
        Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False

        'Classer le tableau des prestations en fonction de la date, puis l'heure de début, puis par client.
        Range("A20:I8019").Select
        ActiveWorkbook.Worksheets("Saisie des prestations").Sort.SortFields.Clear

        ActiveWorkbook.Worksheets("Saisie des prestations").Sort.SortFields.Add Key:= _
            Range("C21:C8019"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
            :=xlSortNormal

        ActiveWorkbook.Worksheets("Saisie des prestations").Sort.SortFields.Add Key:= _
            Range("D21:D8019"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
            :=xlSortNormal

        ActiveWorkbook.Worksheets("Saisie des prestations").Sort.SortFields.Add Key:= _
            Range("B21:B8019"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
            :=xlSortNormal

        With ActiveWorkbook.Worksheets("Saisie des prestations").Sort
            .SetRange Range("A20:I8019")
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With

        'Supprimer les cellules dès qu'elles ont été rajoutées au tableau.
        Range("B9").ClearContents
        Range("B11").ClearContents
        Range("C11").ClearContents
        Range("D9").ClearContents
        Range("E9").ClearContents
        Range("F9").ClearContents
        Range("A3").Select

        Application.ScreenUpdating = True
        Application.Calculation = xlCalculationAutomatic

        ActiveWorkbook.Save

    End Sub

A+

Merci Frangy !

C'est effectivement mieux avec "Application.ScreenUpdating = False" !

Mettre le classeur en calcul manuel est également une très bonne idée, mais j'avais déjà cocher la case dans les options excel.

Là pour l'instant ma macro s'effectue en 15 secondes, et 20 secondes sur un ordi un peu plus ancien. Ca passe encore, mais quand on doit rentrer beaucoups de données, c'est 15 secondes x ... Ce qui fait long.

Encore merci pour ton aide

Bonjour,

Essaie ceci dans ton fichier. Je pense que tu pourrau également supprimer la suspension du calcul automatique

Sub SaisieDesPrestations11()
 ' SaisieDesPrestations11 Macro
   ' Enregistre une nouvelle prestation dans le tableau des prestations.
With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With

Range("B2,B9,B7").Copy 'Copie du nom du responsable, nom du client, la date du jour
Range("A20").End(xlDown).Offset(1, 0).Range("A1").PasteSpecial _
Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True

'Copie de l'heure du début, l'heure de fin
Range("B11:C11").Copy
Range("D20").End(xlDown).Offset(1, 0).PasteSpecial _
Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

'Copie catégorie comptable,type de prestation, période comptable
Range("D9:F9").Copy
Range("F20").End(xlDown).Offset(1, 0).Range("A1").PasteSpecial _
Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

'Classer le tableau des prestations en fonction de la date, puis l'heure de début, puis par client.
Range("A20:I8019").Select
With ActiveWorkbook.Worksheets("Saisie des prestations").Sort.SortFields
    .Clear
    .Add Key:=Range("C21:C8019"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    .Add Key:=Range("D21:D8019"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    .Add Key:=Range("B21:B8019"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
End With
With ActiveWorkbook.Worksheets("Saisie des prestations").Sort
    .SetRange Range("A20:I8019")
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

'Supprimer les cellules dès qu'elles ont été rajoutées au tableau.
Range("B9").ClearContents
Range("B11").ClearContents
Range("C11").ClearContents
Range("D9").ClearContents
Range("E9").ClearContents
Range("F9").ClearContents
Range("A3").Select
With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With
ActiveWorkbook.Save
End Sub

Si ok, n'oublie pas de cliquer sur le V vert à coté du bouton EDITER pour cloturer ta demande

Amicalement

Yes puis que 8 secondes ! on gagne du terrain !

MERCI !

Juste un dernier petit problème...

Range("B2,B9,B7").Copy 'Copie du nom du responsable, nom du client, la date du jour

Range("A20").End(xlDown).Offset(1, 0).Range("A1").PasteSpecial _

Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True

Ma macro copie bien B2, B9, B7, mais quand il me le "Paste" en (Range("A20").End(xlDown).Offset(1, 0).Range("A1").PasteSpecial _), il ne respecte pas l'ordre. Ainsi il inverse deux collones de mon tableau. il colle B2 puis B7 puis B9, au lieu de B2 puis B9 puis B7.

Ca doit être simple de rectifier ca mais je suis encore très débutant. la seule solution que je vois, serais trop ressemblente au code d'origine, et donc pas bon.

Merci pour l'aide

Re

il ne respecte pas l'ordre. Ainsi il inverse deux collones de mon tableau. il colle B2 puis B7 puis B9, au lieu de B2 puis B9 puis B7.

effectivement là tu vas devoir remettre une ligne dans le cod donc changer cette partie

Range("B2,B9").Copy 'Copie du nom du responsable, nom du client, la date du jour
Range("A20").End(xlDown).Offset(1, 0).Range("A1").PasteSpecial _
Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Range("B7").Copy 'Copie du nom du responsable, nom du client, la date du jour
Range("C20").End(xlDown).Offset(1, 0).Range("A1").PasteSpecial Paste:=xlPasteValues

Mais j'ai plutôt l'impression que ce sont tes formules qui font ralentir le code car quand tu remets le calcul en automatique dans ton code, toute la feuille est recalculée bien sûr.

Faudrait peut être que tu donnes ton fichier pour analyser ce qui se passe

A te relire

Oui c'est effectivement lors de l'enregistrement que çà dure... Je ne sais pas si il y a qq chose à faire...

Mais en tout cas, un grand merci pour ton aide ! J'ai encore un peu apprit en lisant ton code car je suis novice en la matière.

Je ne sais pas mettre le fichier en annexe par contre, il fait 2740ko

Bien à toi.