Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Execution Macro très lente

Créer une discussion

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
A

arckeo72

XLDnaute Nouveau
Bonjour à tous,

J’exécute la macro suivante et je trouve l’application plutôt lente.

Comme je ne sais pas comment la simplifier je fais appel à vous.

"Sub Macro1()
'
' Macro1 Macro
'

'
ActiveSheet.Range("$A$2:$S$65536").AutoFilter Field:=7, Criteria1:=Range("J1")
Rows("6:6").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A6").Select
ActiveCell.FormulaR1C1 = "=R[1]C"
Range("B6").Select
ActiveCell.FormulaR1C1 = "=R[1]C+1"
Range("C6").Select
ActiveCell.FormulaR1C1 = "=R[1]C"
Range("D6").Select
ActiveCell.FormulaR1C1 = "=TODAY()"
Range("F7").Select
Selection.Copy
Range("F6").Select
ActiveSheet.Paste
Range("H7").Select
Selection.Copy
Range("H6").Select
ActiveSheet.Paste
Range("J7").Select
Selection.Copy
Range("J6").Select
ActiveSheet.Paste
Range("J1").Select
Selection.Copy
Range("G6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

End Sub"


A noter l'execution de ma macro se fait via celle-ci :

"Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$J$1" Then Call Macro1
End Sub"

D'avance merci.
 
Trier par date Trier par votes
Re : Execution Macro très lente

Bonjour arckeo72
Au plus simple, il est inutile d'utiliser tous ces vilains Select 😀
VB: 
Sub Macro2()
Application.ScreenUpdating = False 'bloquer l'affichage écran
ActiveSheet.Range("$A$2:$S$65536").AutoFilter Field:=7, Criteria1:=Range("J1")
Rows("6:6").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A6").FormulaR1C1 = "=R[1]C"
Range("B6").FormulaR1C1 = "=R[1]C+1"
Range("C6").FormulaR1C1 = "=R[1]C"
Range("D6").FormulaR1C1 = "=TODAY()"
Range("F7").Copy Range("F6")
Range("H7").Copy Range("H6")
Range("J7").Copy Range("J6")
Range("G6").Value = Range("J1").Value
End Sub

Cordialement
 
Vote positif 0 Vote négatif
Re : Execution Macro très lente

Merci beaucoup ça marche nickel.

J'ai également rajouter ceci pour améliorer la vitesse d'exécution :
Au début de la macro
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Avant la fin de la macro
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

Salutations.
 
Vote positif 0 Vote négatif
Bonjour,

Je m'incruste dans la conversation car j'ai fait une macro qui fonctionne bien mais qui est lente...comment puis l'optimiser en sachant que j'ai utilisé la méthode d'arckeo72. Merciiiii

Code: 
Sub Macro1()
'
' Macro1 Macro
'
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

'
Application.Dialogs.Item(xlDialogOpen).Show
           Range("A1:AH" & Range("A65536").End(xlUp).Row).SpecialCells(xlCellTypeVisible).Select
    Selection.Copy
    ActiveWindow.Close
    Windows("Cotisations macro.xlsm").Activate
    Range("A1").Select
    ActiveSheet.Paste
   


    Range("AI1").Select
    ActiveCell.FormulaR1C1 = "Doublons"

'Recherche de doublon dans les contrats
    Range("AI2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(COUNTIF(R2C15:RC[-20],RC[-20])=1,SUMIF(C[-20],RC[-20],C[-4]),"""")"

'Tirer la formule vers le bas
Dim LastRw As Long
LastRw = Sheets("Feuil1").Cells(Rows.Count, 1).End(xlUp).Row
Range("AI2:AI" & LastRw).FillDown


'Analyse les doublons
    Range("AJ1").Select
    ActiveCell.FormulaR1C1 = "Analyse doublons"
    Range("AJ2").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-1]=1,""Pas de doublon"",""Doublon"")"
    Range("AJ2").Select

'Tirer la formule vers le bas
LastRw = Sheets("Feuil1").Cells(Rows.Count, 1).End(xlUp).Row
Range("AJ2:AJ" & LastRw).FillDown

'Masque la cellule
Columns("AI:AI").Select
Selection.EntireColumn.Hidden = True
   
'Recherche des tarifs chelou
Range("AK1").Select
ActiveCell.FormulaR1C1 = "Analyse tarif"
Range("AK2").Select
ActiveCell.FormulaR1C1 = _
"=IFERROR(VLOOKUP(RC[-17],Tarif!R1C1:R152C2,2,FALSE),""Tarif à contrôler"")"

'Tirer la formule vers le bas
LastRw = Sheets("Feuil1").Cells(Rows.Count, 1).End(xlUp).Row
Range("AK2:AK" & LastRw).FillDown


'Colonne pour resumer les contrôles
Range("AL1").Select
ActiveCell.FormulaR1C1 = "Contrôles"
Range("AL2").Select
ActiveCell.FormulaR1C1 = _
"=IF(OR(RC[-2]=""Doublon"",RC[-1]=""Tarif à contrôler""),""Contrôle à faire"",""Pas de contrôle"")"

'Tirer la formule vers le bas
LastRw = Sheets("Feuil1").Cells(Rows.Count, 1).End(xlUp).Row
Range("AL2:AL" & LastRw).FillDown

'copier coller valeurs pour enlever les formules
Columns("AJ:AL").Select
Range("AL1").Activate
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True


End Sub
 
Vote positif 0 Vote négatif
Bonjour

Crées un nouveau fil et mets un fichier exemple pour les tests
en attendant tu devrais gagner un peu de temps sur ton collage de valeurs
Code: 
'copier coller valeurs pour enlever les formules
Range("AJ1:AL" & Range("AJ65536").End(xlUp).Row).Value = Range("AJ1:AL" & Range("AJ65536").End(xlUp).Row).Value
 
Vote positif 0 Vote négatif
Bonjour oz2007, Bonjour Yeahou, le fil, le forum
Comme je disais en 2013 (Déjà 4 ans, que le temps passe....):
Efgé à dit:
il est inutile d'utiliser tous ces vilains Select 😀
Cliquez pour agrandir...
En 2017 je rajoute
Traiter les colonnes au fur et à mesure et éviter les FillDown:
(J'ai mis en commentaire la partie que je ne peux tester)
VB: 
Sub Macro1()
Dim LastRw As Long

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'Application.Dialogs.Item(xlDialogOpen).Show
            'Range("A1:AH" & Range("A65536").End(xlUp).Row).SpecialCells(xlCellTypeVisible).Select
     'Selection.Copy
     'ActiveWindow.Close
     'Windows("Cotisations macro.xlsm").Activate
     'Range("A1").Select
     'ActiveSheet.Paste

Range("AI1") = "Doublons"
Range("AJ1") = "Analyse doublons"
Range("AK1") = "Analyse tarif"
Range("AL1") = "Contrôles"
LastRw = Sheets("Feuil1").Cells(Rows.Count, 1).End(xlUp).Row

'Recherche de doublon dans les contrats
With Range("AI2:AI" & LastRw)
    .FormulaR1C1 = "=IF(COUNTIF(R2C15:RC[-20],RC[-20])=1,SUMIF(C[-20],RC[-20],C[-4]),"""")"
    .Value = .Value
End With
'Analyse les doublons
With Range("AJ2:AJ" & LastRw)
    .FormulaR1C1 = "=IF(RC[-1]=1,""Pas de doublon"",""Doublon"")"
    .Value = .Value
    'Masque la cellule
    .EntireColumn.Hidden = True
End With
'Recherche des tarifs chelou
With Range("AK2:AK" & LastRw)
    .FormulaR1C1 = _
        "=IFERROR(VLOOKUP(RC[-17],Tarif!R1C1:R152C2,2,FALSE),""Tarif à contrôler"")"
    .Value = .Value
End With
'Colonne pour resumer les contrôles
With Range("AL2:AL" & LastRw)
    .FormulaR1C1 = _
        "=IF(OR(RC[-2]=""Doublon"",RC[-1]=""Tarif à contrôler""),""Contrôle à faire"",""Pas de contrôle"")"
    .Value = .Value
End With
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub

Cordialement
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

  • Question Question
XL 2016 copier valeur actuel
2
Réponses
18
Affichages
213
sylvanu
V
  • Question Question
XL 2016 transformer en boucle une macro créer avec l'enregistreur automatique
Réponses
3
Affichages
65
vazvaz
V
  • Question Question
Autres fenêtre "Publication"
Réponses
10
Affichages
468
ph.vanne
H
  • Résolu(e)
XL 2016 Copier cellule dans un autre onglets
2
Réponses
16
Affichages
405
Phil69970
K
  • Question Question
Microsoft 365 vba :Vlookup + incrémentation d'une plage de donnée
Réponses
1
Affichages
173
vgendron
  • Résolu(e)
XL 2021 Exécuter une macro sur plusieurs feuilles
Réponses
9
Affichages
380
micie1509
C
  • Question Question
Microsoft 365 Lenteur macro mise en page
Réponses
7
Affichages
85
CortoXls
C
M
  • Question Question
Microsoft 365 deux macros succesives et un bouton
2
Réponses
17
Affichages
911
MICHAEL
M
N
  • Résolu(e)
Microsoft 365 Macro copier/coller entre deux tableaux structurés
3 4 5
Réponses
66
Affichages
1 K
job75
P
  • Question Question
Microsoft 365 Macro qui plante exel
Réponses
1
Affichages
473
mapomme
R
  • Résolu(e)
XL 2019 creer une macro pour copier des info d un onglet a un autre dans le meme classeur
Réponses
4
Affichages
559
robpellan52
R
S
  • Résolu(e)
Autres ActiveWorkbook.Worksheets("vierge").AutoFilter.Sort.SortFields.Clear
2
Réponses
23
Affichages
2 K
AtTheOne
F
  • Résolu(e)
XL 2021 Réaliser une macro pour copier une ligne avec formule ?
Réponses
4
Affichages
586
fanou06
F
  • Question Question
Microsoft 365 Problème VBA insertion ligne au-desus
Réponses
3
Affichages
674
Mr.Adrien
  • Résolu(e)
Microsoft 365 Macro fonctionnant avec excel 365 sur windows 11 mais ne fonctionnent pas sur un autre windows 11 avec aussi un excel 365
Réponses
11
Affichages
902
mouchtre
K
  • Question Question
XL 2019 Organiser le code VBA
Réponses
9
Affichages
822
Kevin38
K
U
  • Question Question
Autres incorporer une macro dans une autre macro
Réponses
5
Affichages
369
Phil69970
O
  • Question Question
XL 2010 aide sur code VBA collationnement de données
Réponses
10
Affichages
739
olivier388
O
F
  • Résolu(e)
XL 2021 Créer Macro permettant d'indexer des nouveaux clients ? [Résolu]
4 5 6
Réponses
82
Affichages
3 K
fanou06
F
  • Question Question
Autres Simplifier une macro
Réponses
1
Affichages
386
fanch55
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…