Accélérer l'exécution du programme

Bonjour à tous,

Je suis novice en VBA et j'aurai besoin de votre aide...

Pour le job j'ai du créer un planning avec les horaires des agents sur 3 ans, et les managers ne doivent intervenir sur ce planning uniquement lorsqu'il y a une modification à faire, sinon tout est déjà près-rempli.

Il y a une base de donnée et une interface pour les managers, et le problème vient de la macro qui relie les deux feuilles. Le temps d'enregistrement est beaucoup trop long et je ne sais pas comment faire pour améliorer cela...

Je vous laisse le code ci-dessous, si vous avez le temps d'y jeter un coup d'œil ou de me donner quelques conseils, ce serait formidable !

Dim Plage As Range

    Range("P2").Select

    Application.ScreenUpdating = False

    ActiveSheet.ListObjects("PlannSem").Range.AutoFilter Field:=14, Criteria1:= _
        "<>"

    L = Range("G6").Value
    M = Range("H6").Value
    W = Range("I6").Value
    J = Range("J6").Value
    V = Range("K6").Value
    S = Range("L6").Value

    Set PlageLundi = Worksheets("RECAP").Range("T7:T103")
    Set PlageMardi = Worksheets("RECAP").Range("U7:U103")
    Set PlageMercredi = Worksheets("RECAP").Range("V7:V103")
    Set PlageJeudi = Worksheets("RECAP").Range("W7:W103")
    Set PlageVendredi = Worksheets("RECAP").Range("X7:X103")
    Set PlageSamedi = Worksheets("RECAP").Range("Y7:Y103")
    Set PlageSupp = Worksheets("RECAP").Range("Z7:Z103")

    Sheets("Tableau de suivi").Select
    Range("Tableau9[[#Headers],[Année]]").Select
    Selection.AutoFilter
    Selection.AutoFilter
    ActiveSheet.ListObjects("Tableau9").Range.AutoFilter Field:=19, Criteria1:= _
        "OK"
    ActiveSheet.ListObjects("Tableau9").Range.AutoFilter Field:=8, Criteria1:= _
        Array("jeudi", "lundi", "mardi", "mercredi", "samedi", "vendredi"), Operator:= _
        xlFilterValues

    'LUNDI'
    PlageLundi.Copy
    Cells.Find(What:=L, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    ActiveCell.Offset(0, 13).Select
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    'MARDI'
    PlageMardi.Copy
    Range("Tableau9[[#Headers],[Numéro]]").Select
    Cells.Find(What:=M, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    ActiveCell.Offset(0, 13).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    'MERCREDI'
    PlageMercredi.Copy
    Range("Tableau9[[#Headers],[Numéro]]").Select
    Cells.Find(What:=W, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    ActiveCell.Offset(0, 13).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    'JEUDI'
    PlageJeudi.Copy
    Range("Tableau9[[#Headers],[Numéro]]").Select
    Cells.Find(What:=J, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    ActiveCell.Offset(0, 13).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    'VENDREDI'
    PlageVendredi.Copy
    Range("Tableau9[[#Headers],[Numéro]]").Select
    Cells.Find(What:=V, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    ActiveCell.Offset(0, 13).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    'SAMEDI'
    PlageSamedi.Copy
    Range("Tableau9[[#Headers],[Numéro]]").Select
    Cells.Find(What:=S, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    ActiveCell.Offset(0, 13).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    'Heure Supp'
    PlageSupp.Copy
    Range("Tableau9[[#Headers],[Numéro]]").Select
    Cells.Find(What:=L, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    ActiveCell.Offset(0, 16).Select
    ActiveCell.PasteSpecial

    ActiveSheet.ListObjects("Tableau9").Range.AutoFilter Field:=8
    ActiveSheet.ListObjects("Tableau9").Range.AutoFilter Field:=19
    Range("A1").Select

    Sheets("RECAP").Select

    ActiveSheet.ListObjects("PlannSem").Range.AutoFilter Field:=14

    Range("O7:Y7,O10:Y10,O13:Y13,O16:Y16,O19:Y19,O22:Y22,O25:Y25,O28:Y28,O31:Y31,O34:Y34,O37:Y37,O40:Y40,O43:Y43,O46:Y46,O49:Y49,O52:Y52,O55:Y55,O58:Y58,O61:Y61,O64:Y64,O67:Y67,O70:Y70,O73:Y73,O76:Y76").Select
    Selection.EntireRow.Hidden = True

    Range("O73:Y73,O76:Y76,O79:Y79,O82:Y82,O85:Y85,O88:Y88,O91:Y91,O94:Y94,O97:Y97,O100:Y100,O103:Y103").Select
    Selection.EntireRow.Hidden = True

    Range("P2").Select

    Application.ScreenUpdating = True

    MsgBox "Enregistré !"

End Sub

Par avance merci !!

Bonjour et bienvenue sur le forum

Si tu ne joins pas ton fichier, il sera difficile de t"aider.

Bye !

Bonjour !

Le fichier Excel est trop lourd pour le poster ici... du mois je n'ai pas réussi à le réduire assez.

Je vous ai fais 2 captures d'écran des deux interfaces utilisées, en espérant que cela vous sera utile.

Par avance merci !