XL 2019 VBA Temps d'exécution trop long

M

MTX

XLDnaute Nouveau
Bonjour a tous et a toutes

J'ai crée un code a partir de l'enregistreur ,puis j'ai modifier quelques lignes et ajouter des petits bout de code trouver sur les diffèrent forum afin d'adapter au mieux a ma situation.

La plus part des commandes sont répétitives sur chaque feuille de mon classeur.

le souci c'est que chez moi sa met environ 1 minute 20 pour s'exécuter et au boulot sa mets 5 minute pour s'exécuter.

Je cherche un moyen de l'epurée ou optimiser. Afin de gagner en d'exécution de temps.

Merci a tous pour votre aide.

VB: 
Sub refreshALLFEUIILE()
'
' refreshcf Macro
Dim MacroDebut As Date
MacroDebut = Now

Sheets("CF63").Select
Range("SI_CF[[#Headers],[GR SI]]").Select
Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
Range("SF_CF[[#Headers],[GR SF]]").Select
Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False


Sheets("SC46").Select
Range("SI_SC[[#Headers],[GR SI]]").Select
Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
Range("SF_SC[[#Headers],[GR SF]]").Select
Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False

Sheets("MM16").Select
Range("SI_MM[[#Headers],[GR SI]]").Select
Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
Range("SF_MM[[#Headers],[GR SF]]").Select
Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False


Sheets("LG87").Select
Range("SI_LG[[#Headers],[GR SI]]").Select
Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
Range("SF_LG[[#Headers],[GR SF]]").Select
Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False


Sheets("BA64&BI64").Select
Range("SI_BI_BA[[#Headers],[GR SI]]").Select
Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
Range("SF_BI_BA[[#Headers],[GR SF]]").Select
Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False

Sheets("BD33").Select
Range("SI_BD[[#Headers],[GR SI]]").Select
Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
Range("SF_BD[[#Headers],[GR SF]]").Select
Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False


Sheets("PA64").Select
Range("SI_PA[[#Headers],[GR SI]]").Select
Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
Range("SF_PA[[#Headers],[GR SF]]").Select
Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False


Sheets("AU32").Select
Range("SI_AU[[#Headers],[GR SI]]").Select
Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
Range("SF_AU[[#Headers],[GR SF]]").Select
Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False


Sheets("MTM").Select
Range("SI_MTM[[#Headers],[GR SI]]").Select
Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
Range("SF_MTM[[#Headers],[GR SF]]").Select
Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False


Sheets("RD12").Select
Range("SI_RD[[#Headers],[GR SI]]").Select
Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
Range("SF_RD[[#Headers],[GR SF]]").Select
Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False


Sheets("CC11").Select
Range("SI_CC_2[[#Headers],[GR SI]]").Select
Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
Range("SF_CC[[#Headers],[GR SF]]").Select
Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False

Sheets("TO81").Select
Range("SI_TO[[#Headers],[GR SI]]").Select
Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
Range("SF_TO[[#Headers],[GR SF]]").Select
Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False


Sheets("MZ").Select
Range("SI_MZ[[#Headers],[GR SI]]").Select
Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
Range("SF_MZ[[#Headers],[GR SF]]").Select
Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False


Sheets("BR31").Select
Range("SI_BR[[#Headers],[GR SI]]").Select
Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
Range("SF_BR[[#Headers],[GR SF]]").Select
Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False


Sheets(Array("CF63", "MM16", "SC46", "LG87", "BA64&BI64", "BD33", "PA64", "AU32", "MTM" _
, "RD12", "CC11", "TO81", "MZ", "BR31")).Select
Sheets("CF63").Activate
Cells.Select

Rows("4:45").Select
Selection.RowHeight = 75

With Selection.Font
.Name = "Verdana"
.Size = 36
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
ActiveWorkbook.Save
Sheets("LISTEIMPRETION").Select
MsgBox "Durée d'exécution: " & Format(Now - MacroDebut, "hh:mm:ss")
End Sub
 
Solution
R
Autre proposition
VB: 
Sub refreshALLFEUIILE()
    Dim MacroDebut As Date
    MacroDebut = Now
    
    For i = 1 To Sheets.Count
        Select Case Sheets(i).Name
            Case Is = "CF63", "SC46", "MM16", "LG87", "BA64&BI64", "BD33", "PA64", "AU32", "MTM", "RD12", "CC11", "TO81", "MZ", "BR31"
                Sheets(i).Range("SI_CF[[#Headers],[GR SI]]").ListObject.QueryTable.Refresh BackgroundQuery:=False
                Sheets(i).Range("SF_CF[[#Headers],[GR SF]]").ListObject.QueryTable.Refresh BackgroundQuery:=False
        End Select
    Next i
    
    Sheets(Array("CF63", "MM16", "SC46", "LG87", "BA64&BI64", "BD33", "PA64", "AU32", "MTM" _
    , "RD12", "CC11", "TO81", "MZ", "BR31")).Select
    Cells.Select...
Trier par date Trier par votes
R

Rouge

XLDnaute Impliqué
Bonjour,

Essayez ceci, (attention, pas pu vérifier)
VB: 
Sub refreshALLFEUIILE()
    '
    ' refreshcf Macro
    Dim f1 As Worksheet, f2 As Worksheet, f3 As Worksheet, f4 As Worksheet, f5 As Worksheet, f6 As Worksheet, f7 As Worksheet, f8 As Worksheet
    Dim f9 As Worksheet, f10 As Worksheet, f11 As Worksheet, f12 As Worksheet, f13 As Worksheet, f14 As Worksheet, f15 As Worksheet
    Dim MacroDebut As Date
    MacroDebut = Now
    
    Set f1 = Sheets("CF63")
    Set f2 = Sheets("SC46")
    Set f3 = Sheets("MM16")
    Set f4 = Sheets("LG87")
    Set f5 = Sheets("BA64&BI64")
    Set f6 = Sheets("BD33")
    Set f7 = Sheets("PA64")
    Set f8 = Sheets("AU32")
    Set f9 = Sheets("MTM")
    Set f10 = Sheets("RD12")
    Set f11 = Sheets("CC11")
    Set f12 = Sheets("TO81")
    Set f13 = Sheets("MZ")
    Set f14 = Sheets("BR31")
    Set f15 = Sheets("LISTEIMPRETION")
    
    f1.Range("SI_CF[[#Headers],[GR SI]]").ListObject.QueryTable.Refresh BackgroundQuery:=False
    f1.Range("SF_CF[[#Headers],[GR SF]]").ListObject.QueryTable.Refresh BackgroundQuery:=False
    
    f2.Range("SI_SC[[#Headers],[GR SI]]").ListObject.QueryTable.Refresh BackgroundQuery:=False
    f2.Range("SF_SC[[#Headers],[GR SF]]").ListObject.QueryTable.Refresh BackgroundQuery:=False
    
    f3.Range("SI_MM[[#Headers],[GR SI]]").ListObject.QueryTable.Refresh BackgroundQuery:=False
    f3.Range("SF_MM[[#Headers],[GR SF]]").ListObject.QueryTable.Refresh BackgroundQuery:=False
    
    f4.Range("SI_LG[[#Headers],[GR SI]]").ListObject.QueryTable.Refresh BackgroundQuery:=False
    f4.Range("SF_LG[[#Headers],[GR SF]]").ListObject.QueryTable.Refresh BackgroundQuery:=False
    
    f5.Range("SI_BI_BA[[#Headers],[GR SI]]").ListObject.QueryTable.Refresh BackgroundQuery:=False
    f5.Range("SF_BI_BA[[#Headers],[GR SF]]").ListObject.QueryTable.Refresh BackgroundQuery:=False
    
    f6.Range("SI_BD[[#Headers],[GR SI]]").ListObject.QueryTable.Refresh BackgroundQuery:=False
    f6.Range("SF_BD[[#Headers],[GR SF]]").ListObject.QueryTable.Refresh BackgroundQuery:=False
    
    f7.Range("SI_PA[[#Headers],[GR SI]]").ListObject.QueryTable.Refresh BackgroundQuery:=False
    f7.Range("SF_PA[[#Headers],[GR SF]]").ListObject.QueryTable.Refresh BackgroundQuery:=False
    
    f8.Range("SI_AU[[#Headers],[GR SI]]").ListObject.QueryTable.Refresh BackgroundQuery:=False
    f8.Range("SF_AU[[#Headers],[GR SF]]").ListObject.QueryTable.Refresh BackgroundQuery:=False
    
    f9.Range("SI_MTM[[#Headers],[GR SI]]").ListObject.QueryTable.Refresh BackgroundQuery:=False
    f9.Range("SF_MTM[[#Headers],[GR SF]]").ListObject.QueryTable.Refresh BackgroundQuery:=False
    
    f10.Range("SI_RD[[#Headers],[GR SI]]").ListObject.QueryTable.Refresh BackgroundQuery:=False
    f10.Range("SF_RD[[#Headers],[GR SF]]").ListObject.QueryTable.Refresh BackgroundQuery:=False
    
    f11.Range("SI_CC_2[[#Headers],[GR SI]]").ListObject.QueryTable.Refresh BackgroundQuery:=False
    f11.Range("SF_CC[[#Headers],[GR SF]]").ListObject.QueryTable.Refresh BackgroundQuery:=False
    
    f12.Range("SI_TO[[#Headers],[GR SI]]").ListObject.QueryTable.Refresh BackgroundQuery:=False
    f12.Range("SF_TO[[#Headers],[GR SF]]").ListObject.QueryTable.Refresh BackgroundQuery:=False
    
    f13.Range("SI_MZ[[#Headers],[GR SI]]").ListObject.QueryTable.Refresh BackgroundQuery:=False
    f13.Range("SF_MZ[[#Headers],[GR SF]]").ListObject.QueryTable.Refresh BackgroundQuery:=False
    
    f14.Range("SI_BR[[#Headers],[GR SI]]").ListObject.QueryTable.Refresh BackgroundQuery:=False
    f14.Range("SF_BR[[#Headers],[GR SF]]").ListObject.QueryTable.Refresh BackgroundQuery:=False
    
    Sheets(Array("CF63", "MM16", "SC46", "LG87", "BA64&BI64", "BD33", "PA64", "AU32", "MTM" _
    , "RD12", "CC11", "TO81", "MZ", "BR31")).Select
    Cells.Select
    Rows("4:45").Select
    Selection.RowHeight = 75
    With Selection.Font
        .Name = "Verdana"
        .Size = 36
        .Underline = xlUnderlineStyleNone
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    ActiveWorkbook.Save
    f15.Select
    MsgBox "Durée d'exécution: " & Format(Now - MacroDebut, "hh:mm:ss")
    
    Set f1 = Nothing
    Set f2 = Nothing
    Set f3 = Nothing
    Set f4 = Nothing
    Set f5 = Nothing
    Set f6 = Nothing
    Set f7 = Nothing
    Set f8 = Nothing
    Set f9 = Nothing
    Set f10 = Nothing
    Set f11 = Nothing
    Set f12 = Nothing
    Set f13 = Nothing
    Set f14 = Nothing
    Set f15 = Nothing
End Sub

Cdlt
 
Vote positif 0 Vote négatif
R

Rouge

XLDnaute Impliqué
Autre proposition
VB: 
Sub refreshALLFEUIILE()
    Dim MacroDebut As Date
    MacroDebut = Now
    
    For i = 1 To Sheets.Count
        Select Case Sheets(i).Name
            Case Is = "CF63", "SC46", "MM16", "LG87", "BA64&BI64", "BD33", "PA64", "AU32", "MTM", "RD12", "CC11", "TO81", "MZ", "BR31"
                Sheets(i).Range("SI_CF[[#Headers],[GR SI]]").ListObject.QueryTable.Refresh BackgroundQuery:=False
                Sheets(i).Range("SF_CF[[#Headers],[GR SF]]").ListObject.QueryTable.Refresh BackgroundQuery:=False
        End Select
    Next i
    
    Sheets(Array("CF63", "MM16", "SC46", "LG87", "BA64&BI64", "BD33", "PA64", "AU32", "MTM" _
    , "RD12", "CC11", "TO81", "MZ", "BR31")).Select
    Cells.Select
    Rows("4:45").Select
    Selection.RowHeight = 75
    With Selection.Font
        .Name = "Verdana"
        .Size = 36
        .Underline = xlUnderlineStyleNone
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    ActiveWorkbook.Save
    Sheets("LISTEIMPRETION").Select
    MsgBox "Durée d'exécution: " & Format(Now - MacroDebut, "hh:mm:ss")
End Sub

Cdlt
 
Vote positif 0 Vote négatif
Solution
Dranreb

Dranreb

XLDnaute Barbatruc
Bonjour.
Est-ce qu'il ne serait pas possible de faire quelque chose de ce genre ? :
VB: 
Dim Wsh As Worksheet, LOt As ListObject
For Each Wsh In ThisWorkbook.Worksheets
   For Each LOt In Wsh.ListObjects
      If LOt.Name Like "S?_" & Left$(Wsh.Name, 2) Then LOt.QueryTable.Refresh BackgroundQuery:=False
      Next LOt, Wsh
Ou même ça peut être ? :
Code: 
Dim Wsh As Worksheet, QTe As QueryTable
For Each Wsh In ThisWorkbook.Worksheets
   For Each QTe In Wsh.QueryTables
      QTe.Refresh BackgroundQuery:=False
      Next QTe, Wsh
Et quid de ThisWorkbook.RefreshAll tout simplement ?
 
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

M
  • Question
Microsoft 365 Programme trop lent
Réponses
12
Affichages
839
Hasco
Hasco
S
  • Résolu(e)
XL 2016 Séparateurs décimales & milliers sur un import csv
2
Réponses
18
Affichages
2 K
sabrina_
S
S
  • Question
Temps d'exécution d'une macro trop long : help !
Réponses
6
Affichages
2 K
grandjules
G

Membres actuellement en ligne

9 membres et 189 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 629
Messages
2 111 351
Membres
111 111
dernier inscrit
houndemint