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

Accélérer une macro qui est longue.

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?
 

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:

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
 

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:

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:

Staple1600

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

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
 

Broch002

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

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

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

Merci.
 
Dernière édition:

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…