Améliorer vitesse d'éxécution

[teamtat]

Bonjour,
Je voudrais savoir si il été possible d'accéléré la vitesse d'éxécution de ce code VBA ??
Merci

Select Case MsgBox("Contrôl final ?", vbYesNo + vbQuestion, "Titre de la MsgBox")
Case vbYes
'procédure si click sur Oui

Dim Chemin As String, Fichier As String
Dim wk As Workbook
'*******Variable à définir**************
Chemin = "\\Angfs1\data\TKAF\R01\A427\_Commun-Agence\GENERAL\Dossier Camille\"
Fichier = "TX_Asc_Controle_final_LB_v68_test.xls"
'***************************************
Application.ScreenUpdating = False
Set wk = Workbooks.Open(Chemin & Fichier)

ThisWorkbook.Worksheets("Saisie de données").Range("C2").Copy
wk.Worksheets("Masque saisie").Range("C4").PasteSpecial xlPasteAll, , , True

ThisWorkbook.Worksheets("Saisie de données").Range("C3").Copy
wk.Worksheets("Masque saisie").Range("G4").PasteSpecial xlPasteAll, , , True

ThisWorkbook.Worksheets("Saisie de données").Range("C1").Copy
wk.Worksheets("Masque saisie").Range("E4").PasteSpecial xlPasteAll, , , True


With ThisWorkbook.Worksheets("Saisie de données")
If .CheckBox5.Value = True Or .CheckBox6.Value = True Or .CheckBox1.Value = True Or .CheckBox64.Value = True Or .CheckBox2.Value = True Or .CheckBox3.Value = True Or .CheckBox8.Value = True Or .CheckBox12.Value = True Or .CheckBox17.Value = True Or .CheckBox65.Value = True Or .CheckBox18.Value = True Then
         
     wk.Worksheets("Masque saisie").mac2 = True
Else
      wk.Worksheets("Masque saisie").mac2 = False
End If
End With

'************************************************************************************

With ThisWorkbook.Worksheets("Saisie de données")
If .CheckBox13.Value = True Or .CheckBox14.Value = True Or .CheckBox16.Value = True Then
         
     wk.Worksheets("Masque saisie").mac3 = True
Else
      wk.Worksheets("Masque saisie").mac3 = False
End If
End With

'***************************************************************************************

If ThisWorkbook.Worksheets("Saisie de données").CheckBox15.Value = True Then
      wk.Worksheets("Masque saisie").mac1 = True
Else
      wk.Worksheets("Masque saisie").mac1 = False
End If

Application.CutCopyMode = True
wk.Close True

 

[Benjy]

Re : Améliorer vitesse d'éxécution

Mais tu peux éventuellement faire un Test avec un fichier sur le bureau pour voir si le problème vient de là. Bien que j'en doute...