Translate

Partager via

Macro visual basic très lente sur excel

Edouard Fatio 0 Points de réputation
2025-05-09T08:55:23.6833333+00:00

Bonjour,

Mes macros excel mettent beaucoup de temps à s'executé ?

Sub SauvegardeReOuverture()

Application.ScreenUpdating = False



If Feuil1.Range("C1") = 0 Then

    MsgBox "L'installation existe pas veuillez contrôler le numéro SVP", vbOKOnly + vbInformation, "DONNEES FAUSSES"

    

    Exit Sub

    Else

If Feuil1.Range("D8") = "" Or Feuil1.Range("D10") = "" Or Feuil1.Range("D12") = "" Or Feuil1.Range("D14") = "" Or Feuil1.Range("D16") = "" Or Feuil1.Range("D18") = "" _

Or Feuil1.Range("D20") = "" Or Feuil1.Range("D24") = "" Or Feuil1.Range("D30") = "" _

Or Feuil1.Range("D32") = "" Or Feuil1.Range("D34") = "" Or Feuil1.Range("D36") = "" Then

    MsgBox "Vous n'avez pas sélectionné de Numéro d'installation ou pas fait la réouverture", vbOKOnly + vbInformation, "DONNEES MANQUANTES"

Exit Sub

Else

    Feuil4.Activate

    Range("L2").Select

    Do Until ActiveCell = Feuil1.Range("L3")

        ActiveCell.Offset(1, 0).Select                  'N° Installation

    Loop

    ActiveCell.Offset(0, -8) = Feuil1.Range("D3")       'N° Site

    ActiveCell.Offset(0, -7) = Feuil1.Range("E3")       'N° Affaire

    ActiveCell.Offset(0, -6) = Feuil1.Range("F3")       'N° position installation

    ActiveCell.Offset(0, -5) = Feuil1.Range("G3")       'N° Année

    ActiveCell.Offset(0, -4) = Feuil1.Range("H3")       'N° Département

    ActiveCell.Offset(0, -3) = Feuil1.Range("I3")       'N° Fournisseur

    ActiveCell.Offset(0, -2) = Feuil1.Range("J3")       'N° Produit

    ActiveCell.Offset(0, -1) = Feuil1.Range("K3")       'options

    ActiveCell.Offset(0, 1) = Feuil1.Range("M3")        'Commandé le

    ActiveCell.Offset(0, 2) = Feuil1.Range("N3")        'Arrivée le

    ActiveCell.Offset(0, 3) = Feuil1.Range("O3")        'Nom chantier Rieder

    ActiveCell.Offset(0, 4) = Feuil1.Range("P3")        'Nom chantier client

    ActiveCell.Offset(0, 5) = Feuil1.Range("Q3")        'Client contact

    ActiveCell.Offset(0, 6) = Feuil1.Range("R3")        'Mail client

    ActiveCell.Offset(0, 7) = Feuil1.Range("S3")        'Vendeur

    ActiveCell.Offset(0, 8) = Feuil1.Range("T3")        'Contremaître

    ActiveCell.Offset(0, 9) = Feuil1.Range("U3")        'Chef monteur

    ActiveCell.Offset(0, 10) = Feuil1.Range("V3")        'Région

    ActiveCell.Offset(0, 11) = Feuil1.Range("W3")        'a visiter le

    ActiveCell.Offset(0, 12) = Feuil1.Range("X3")        'formation accès chantier

    ActiveCell.Offset(0, 13) = Feuil1.Range("Y3")        'fer cornières

    ActiveCell.Offset(0, 14) = Feuil1.Range("Z3")        'Plaquette CE

    ActiveCell.Offset(0, 15) = Feuil1.Range("AA3")        'Plaque charge info

    ActiveCell.Offset(0, 16) = Feuil1.Range("AB3")        'Boucles levages

    ActiveCell.Offset(0, 17) = Feuil1.Range("AC3")        'autre fournitures

    ActiveCell.Offset(0, 18) = Feuil1.Range("AD3")        'test charge kg

    ActiveCell.Offset(0, 19) = Feuil1.Range("AE3")        'OIBT

    ActiveCell.Offset(0, 20) = Feuil1.Range("AF3")        'Manuel Utilisation

    ActiveCell.Offset(0, 21) = Feuil1.Range("AG3")        'Doc technique

    ActiveCell.Offset(0, 22) = Feuil1.Range("AH3")        'Interverrouillage

    ActiveCell.Offset(0, 23) = Feuil1.Range("AI3")        'Res1

    ActiveCell.Offset(0, 24) = Feuil1.Range("AJ3")        'Res2

    ActiveCell.Offset(0, 25) = Feuil1.Range("AK3")        'Res3

    ActiveCell.Offset(0, 26) = Feuil1.Range("AL3")        'Res4

    ActiveCell.Offset(0, 27) = Feuil1.Range("AM3")        'Res5

    ActiveCell.Offset(0, 28) = Feuil1.Range("AN3")        'Res6

    ActiveCell.Offset(0, 29) = Feuil1.Range("AO3")        'Res7

    ActiveCell.Offset(0, 30) = Feuil1.Range("AP3")        'Res8

    ActiveCell.Offset(0, 31) = Feuil1.Range("AQ3")        'Res9

    ActiveCell.Offset(0, 32) = Feuil1.Range("AR3")        'Tolerie

    ActiveCell.Offset(0, 33) = Feuil1.Range("AS3")        'Mecanique

    ActiveCell.Offset(0, 34) = Feuil1.Range("AT3")        'Electrique

    ActiveCell.Offset(0, 35) = Feuil1.Range("AU3")        'Communication

    ActiveCell.Offset(0, 36) = Feuil1.Range("AV3")        'Peinture thermo galva

    ActiveCell.Offset(0, 37) = Feuil1.Range("AW3")        'F_Res1

    ActiveCell.Offset(0, 38) = Feuil1.Range("AX3")        'F_Res2

    ActiveCell.Offset(0, 39) = Feuil1.Range("AY3")        'F_Res3

    ActiveCell.Offset(0, 40) = Feuil1.Range("AZ3")        'F_Res4

    ActiveCell.Offset(0, 41) = Feuil1.Range("BA3")        'F_Res5

    ActiveCell.Offset(0, 42) = Feuil1.Range("BB3")        'F_Res6

    ActiveCell.Offset(0, 43) = Feuil1.Range("BC3")        'F_Res7

    ActiveCell.Offset(0, 44) = Feuil1.Range("BD3")        'F_Res8

    ActiveCell.Offset(0, 45) = Feuil1.Range("BE3")        'F_Res9

    ActiveCell.Offset(0, 46) = Feuil1.Range("BF3")        'F_Res10

    ActiveCell.Offset(0, 47) = Feuil1.Range("BG3")        'Affaire terminée

    ActiveCell.Offset(0, 48) = Feuil1.Range("BH3")        'Reste à faire si non

    ActiveCell.Offset(0, 49) = Feuil1.Range("BI3")        'Remarque

    ActiveCell.Offset(0, 50) = Feuil1.Range("BJ3")        'A protocoler

    ActiveCell.Offset(0, 51) = Feuil1.Range("BK3")        'Problèmes rencontrer

    

    

    

    

    

    'Si besoin faire la suite des autres colonnes...

    

End If

End If



    MsgBox ("Merveilleux magnifique !! :-) tu as mis à jour l'Installation N°[ " & Feuil1.Range("L3") & " ] dans la base de données.")

    Feuil1.Activate

Range("D8").Select

Selection.ClearContents

Range("D10").Select

Selection.ClearContents

Range("D12").Select

Selection.ClearContents

Range("D14").Select

Selection.ClearContents

Range("D16").Select

Selection.ClearContents

Range("D18").Select

Selection.ClearContents

Range("D20").Select

Selection.ClearContents

Range("D22").Select

Selection.ClearContents

'Range("D24").Select

'Selection.ClearContents

Range("D26").Select

Selection.ClearContents

Range("D28").Select

Selection.ClearContents

Range("D30").Select

Selection.ClearContents

Range("D32").Select

Selection.ClearContents

Range("D34").Select

Selection.ClearContents

Range("D36").Select

Selection.ClearContents

Range("D38").Select

Selection.ClearContents

Range("D40").Select

Selection.ClearContents

Range("D42").Select

Selection.ClearContents

Range("D44").Select

Selection.ClearContents

Range("D46").Select

Selection.ClearContents

Range("H8").Select

Selection.ClearContents

Range("H14").Select

Selection.ClearContents

Range("H20").Select

Selection.ClearContents

Range("H22").Select

Selection.ClearContents

Range("H24").Select

Selection.ClearContents

Range("H32").Select

Selection.ClearContents

Range("H34").Select

Selection.ClearContents

Range("H36").Select

Selection.ClearContents

Range("H38").Select

Selection.ClearContents

Range("H40").Select

Selection.ClearContents

Range("H42").Select

Selection.ClearContents

Range("H44").Select

Selection.ClearContents

Range("H46").Select

Selection.ClearContents

Range("L20").Select

Selection.ClearContents

Range("L22").Select

Selection.ClearContents

Range("L24").Select

Selection.ClearContents

Range("L26").Select

Selection.ClearContents

Range("L28").Select

Selection.ClearContents

'Range("L30").Select

'Selection.ClearContents

Range("L32").Select

Selection.ClearContents

Range("L36").Select

Selection.ClearContents

Range("L38").Select

Selection.ClearContents

Range("L40").Select

Selection.ClearContents

Range("L42").Select

Selection.ClearContents

Range("L44").Select

Selection.ClearContents

Range("L46").Select

Selection.ClearContents

Range("F30").Select

Selection.ClearContents

Range("D10").Select

End Sub

Visual Basic pour Applications
0 commentaires

Votre réponse

Les réponses peuvent être marquées comme Réponses acceptées par l’auteur de la question, ce qui permet aux utilisateurs de connaître la réponse qui a résolu le problème de l’auteur.