Accélérer une macro qui est longue.

B

Broch002

XLDnaute Occasionnel
Bonjour,

J'ai créer une Macro qui en enchaîne une autre en utilisant l’enregistreur Excel.
Elle fonctionne parfaitement mais elle est un peu longue.
J'ai chercher et trouver que l'on pouvait simplifier ce que l'enregistreur écrit et gagner beaucoup de temps. J'ai essayé avec des exemples mais je m'y perds et cela fait planter la macro.
Voici les deux macros tel-quel:

"Sub DETAIL_SECTEUR()

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets("Feuil1").Select
Cells.Select
Selection.AutoFilter
Sheets("2011").Select
Columns("A:K").Select
Selection.Copy
Sheets("Feuil1").Select
Columns("A:A").Select
ActiveSheet.Paste
Rows("1:4").Select
Application.CutCopyMode = False
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A5:K5").Select
Selection.AutoFilter
Columns("D:E").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("A5:I5").Select
Selection.AutoFilter
Range("b5:I5").Select
Selection.AutoFilter
Range("b2:I2").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
With Selection.Font
.Name = "Calibri"
.Size = 24
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
Sheets("Feuil1").Select
Sheets("Feuil1").Copy Before:=Sheets(1)
Sheets("Feuil1 (2)").Select
Sheets("Feuil1 (2)").Name = "Détail commande"
Range("C5").Select
Call MISE_EN_PAGE_DETAIL_COMMANDE_SECTEUR
End Sub


Sub MISE_EN_PAGE_DETAIL_COMMANDE_SECTEUR()

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Columns("A:A").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Rows("4:4").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("B9").Select
ActiveWindow.DisplayGridlines = False
Range("D6").Select
Selection.Copy
Range("E6").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Selection.Copy
Range("F6").Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
Range("C6").Select
ActiveCell.FormulaR1C1 = "RESEAUX"
Range("B4").Select
ActiveCell.FormulaR1C1 = "Volume"
Range("C4").Select
ActiveCell.FormulaR1C1 = "=SUBTOTAL(109,R[-2]C[6]:R[49996]C[6])"
Range("G4").Select
ActiveCell.FormulaR1C1 = "CA"
Range("H4").Select
ActiveCell.FormulaR1C1 = "=SUBTOTAL(109,R[-2]C[2]:R[49996]C[2])"
Range("B2:J2").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
Selection.UnMerge
With Selection
.HorizontalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Application.ScreenUpdating = False
Selection.Merge
ActiveCell.FormulaR1C1 = "Secteur 20"
Range("B2:J2").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
With Selection.Font
.Name = "Calibri"
.Size = 20
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
Range("B4").Select
With Selection.Font
.Name = "Calibri"
.Size = 18
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
Range("C4").Select
With Selection.Font
.Name = "Calibri"
.Size = 18
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
Range("G4").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Application.ScreenUpdating = False
With Selection.Font
.Name = "Calibri"
.Size = 18
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
Range("H4").Select
Selection.NumberFormat = "0.0"
Selection.NumberFormat = "0"
Range("H4").Select
Selection.NumberFormat = "_($* #,##0_);_($* (#,##0);_($* ""-""_);_(@_)"
Range("H4:J4").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Merge
With Selection.Font
.Name = "Calibri"
.Size = 18
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
Application.ScreenUpdating = False
Columns("B:B").ColumnWidth = 37.43
Columns("C:C").ColumnWidth = 14.71
Columns("F:F").ColumnWidth = 15.14
Columns("H:H").ColumnWidth = 14.14
Range("B4").Select
With Selection
.HorizontalAlignment = xlRight
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("B6:J18213").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Range("B9").Select
ActiveWindow.View = xlPageLayoutView
ActiveWindow.View = xlPageBreakPreview
ActiveSheet.VPageBreaks(1).DragOff Direction:=xlToRight, RegionIndex:=1
ActiveWindow.SmallScroll Down:=66
Rows("10000:50000").Select
Selection.Delete Shift:=xlUp
Range("C2").Select
ActiveWindow.View = xlNormalView
Range("C6:J6").Select
Selection.AutoFilter
Range("B6:J6").Select
Selection.AutoFilter
Application.ScreenUpdating = True
End Sub"

Voila, cela fonctionne bien mais c'est très long.

Si quelqu'un peu m'aider?:)
 
Trier par date Trier par votes
Staple1600

Staple1600

XLDnaute Barbatruc
Re : Accélérer une macro qui est longue.

Bonsoir


Commence par supprimer les Select selon ce principe
Au lieu de
Code: 
Sheets("2011").Select
     Columns("A:K").Select
     Selection.Copy
     Sheets("Feuil1").Select
     Columns("A:A").Select
     ActiveSheet.Paste
Tu peux écrire:

Code: 
Sheets("2011").Columns("A:K").Copy
     Sheets("Feuil1").Columns("A:A").Paste
En faisant cela sur le reste de ton code, tu allégeras celui-ci , de façon assez significative.

PS: Pour rendre ton message plus agréable à lire, utilises les balises BBCODE:[NOPARSE]
Code:
[/NOPARSE]
 
Dernière édition:
Vote positif 0 Vote négatif
B

Broch002

XLDnaute Occasionnel
Re : Accélérer une macro qui est longue.

Bonjour, Staple1600

Après remplacement de l'exemple, il y a un bug.
438 propriété ou méthode non géré par cette objet

Code
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets("Feuil1").Select
Cells.Select
Selection.AutoFilter
Sheets("2011").Columns("A:K").Copy
Sheets("Feuil1").Columns("A:A").Paste
Rows("1:4").Select
Application.CutCopyMode = False
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A5:K5").Select
Selection.AutoFilter
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Re : Accélérer une macro qui est longue.

Bonjour


Par hasard , aurais-tu zappé le PS de mon précédent message ?

Pour l'erreur , essaie ceci (puis va, stp, relire la charte du forum ou on parle de l'intérêt de joindre un fichier exemple...)

EDITION: Cela marche aussi dans sa plus simple expression
Code: 
Sub a_okBis()
Sheets("2011").Columns("A:K").Copy Destination:=Sheets("Feuil1").[A1]
Application.CutCopyMode = False
End Sub

Code: 
Sub a_ok() ' j'ai fais le test avant de poster ceci
With Sheets("2011")
    .Activate 'Facultatif
    .Columns("A:K").Copy Destination:=Sheets("Feuil1").[A1]
End With
Application.CutCopyMode = False
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
B

Broch002

XLDnaute Occasionnel
Re : Accélérer une macro qui est longue.

Bonjour,
Merveilleux, cela fonctionne. Je suis en train de supprimer tous les "sélect", mais je butte sur ce code , il Bug:(

Code
Range("C12").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Mon code modifié qui bug:

Range("C12").Copy.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Merci d'avance.
 
Dernière édition:
Vote positif 0 Vote négatif
B

Broch002

XLDnaute Occasionnel
Re : Accélérer une macro qui est longue.

Staple1600 à dit:
Bonsoir

Toujours pas de PJ ? Ce serait pourtant plus pratique pour faire les tests...

Pour débloquer ce qui bloque, préférez ceci
Code: 
With Range("C12")
.Value=.Value
End With
Cliquez pour agrandir...

Bonjour,
Je ne peux pas joindre le fichier, il est énorme.
J'essaye de suite votre proposition. concernant le blocage.

Merci.:eek:
 
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

S
  • Résolu(e)
XL 2019 VBA pour créer un nouvel onglet
Réponses
2
Affichages
492
sum01
S
K
  • Question
XL 2019 Organiser le code VBA
Réponses
9
Affichages
599
Kevin38
K
H
  • Question
XL 2016 Mettre des titres avec une mise en forme spécifique
Réponses
1
Affichages
305
vgendron
vgendron
B
  • Résolu(e)
XL 2016 concours / Macro imprimer le texte au maximum selon les pages
Réponses
10
Affichages
544
berru76
B
S
  • Question
Microsoft 365 Erreur d'exécution '91'
Réponses
11
Affichages
479
Staple1600
Staple1600
R
  • Question
XL 2016 Rendre plus lisible un code VBA
2
Réponses
23
Affichages
1 K
TooFatBoy
TooFatBoy
M
  • Résolu(e)
XL 2016 Amélioration de code
Réponses
3
Affichages
391
M@xu3L
M
L
  • Question
XL 2016 Macro et suppressions de lignes
Réponses
9
Affichages
625
fanfan38
fanfan38
B
  • Résolu(e)
XL 2016 Modifier ou créer une macro imprimer une sélection de zones
Réponses
5
Affichages
519
berru76
B
F
  • Résolu(e)
XL 2021 Créer Macro permettant d'indexer des nouveaux clients ? [Résolu]
4 5 6
Réponses
82
Affichages
2 K
fanou06
F

Membres actuellement en ligne

23 membres et 404 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
312 463
Messages
2 088 623
Membres
103 893
dernier inscrit
FAB59163