Optimiser son Code VBA
a
Bonjour à la communauté Exceller-Practicien,
Depuis quelques semaines, j'ai commencé à travaillé sur Excel et notamment la création des macros.
Mais je me confronte à un problème qui est d'optimiser mon code pour qu'il soit un peu plus court.
Code s’exécute bien et réaliser la tache que je lui demande mais le code me semble long et non optimal. Et cela génère des problèmes de lenteur.
Serait-ce possible de m'apporter un coup de main? Je suis assez novice sous Excel et les macro.
Comment pourrais faire pour joindre mon code?
Merci à vous pour vos réponse
Sub AjouterFeuille()
' Delete Sheets
Sheets(Array("Output Summary", "Exports Summary", "GVA Summary", "Employment Summary")).Select
ActiveWindow.SelectedSheets.Delete
' ///////////////////////////////////////ADDING SHEETS\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
Static I As Long ' Une variable statique garde sa valeur à chaque appel
Dim Sheet As Worksheet ' Une référence à la feuille nouvellement créée
Sheets.Add.Move After:=Sheets(Sheets.Count) ' La référence est posée
Worksheets(Sheets.Count).Name = "Output Summary" ' Le nom d'onglet de la nouvelle feuille est posé."
Static II As Long
Dim SheetII As Worksheet
Sheets.Add.Move After:=Sheets(Sheets.Count)
Worksheets(Sheets.Count).Name = "Exports Summary"
'-----------------------------------------------------------------------------------------------------------------
' ///////////////////////////////////////OUTPUT SHEET\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
' Copyformat from outputsheet
Sheets("OUTPUT").Select
Range("C1:D308").Select
Selection.Copy
Sheets("Output Summary").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
ActiveSheet.Paste
' modifier la taille et le format des cellules
Sheets("Output Summary").Select
Application.CutCopyMode = False
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Sheets("Output Summary").Select
Range("A1:B7").Select
Range("A7").Activate
With Selection.Font
.ColorIndex = xlAutomatic
.TintAndShade = 0
End With
Sheets("Output Summary").Select
Range("A8:B8").Select
ActiveWindow.SmallScroll Down:=279
Range("A8:B308").Select
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Sheets("Output Summary").Select
Rows("36:36").RowHeight = 19.5
Rows("43:43").RowHeight = 19.5
Rows("50:50").RowHeight = 21.75
Rows("57:57").RowHeight = 22.5
Rows("64:64").RowHeight = 18.75
Rows("71:71").RowHeight = 21
Rows("71:71").RowHeight = 26.25
Rows("78:78").RowHeight = 22.5
Rows("78:78").RowHeight = 28.5
Rows("85:85").RowHeight = 26.25
Rows("92:92").RowHeight = 26.25
Rows("99:99").RowHeight = 23.25
Rows("106:106").RowHeight = 27.75
Rows("113:113").RowHeight = 26.25
Rows("120:120").RowHeight = 27.75
Rows("127:127").RowHeight = 24
Rows("134:134").RowHeight = 24
Rows("141:141").RowHeight = 25.5
Rows("155:155").RowHeight = 25.5
Rows("162:162").RowHeight = 24.75
Rows("190:190").RowHeight = 22.5
Rows("218:218").RowHeight = 24.75
Rows("225:225").RowHeight = 27.75
Rows("232:232").RowHeight = 22.5
Rows("239:239").RowHeight = 23.25
Rows("246:246").RowHeight = 27.75
Rows("253:253").RowHeight = 21.75
Rows("260:260").RowHeight = 21.75
Rows("274:274").RowHeight = 24
Rows("295:295").RowHeight = 27
Rows("302:302").RowHeight = 26
' Ecrire les differentes colonnes avec les titres
Sheets("Output Summary").Select
Range("C5").Select
ActiveCell.FormulaR1C1 = "CEPA1 - 9"
Range("D5").Select
ActiveCell.FormulaR1C1 = "TOT_CEPA"
Range("E5").Select
ActiveCell.FormulaR1C1 = "CEPA1-9<=TOT_CEPA"
Range("F5").Select
ActiveCell.FormulaR1C1 = "CEPA112_122"
Range("G5").Select
ActiveCell.FormulaR1C1 = "CEPA1"
Range("H5").Select
ActiveCell.FormulaR1C1 = "CEPA112_122<=CEPA1"
Range("I5").Select
ActiveCell.FormulaR1C1 = "CEPA7+...9"
Range("J5").Select
ActiveCell.FormulaR1C1 = "CEPA7-9"
Range("K5").Select
ActiveCell.FormulaR1C1 = "CEPA7+...9<=CEPA7-9"
Range("L5").Select
ActiveCell.FormulaR1C1 = "CEPA812"
Range("M5").Select
ActiveCell.FormulaR1C1 = "CEPA8"
Range("N5").Select
ActiveCell.FormulaR1C1 = "CEPA812<=CEPA8"
Range("O5").Select
ActiveCell.FormulaR1C1 = "CReMA10+...16"
Range("P5").Select
ActiveCell.FormulaR1C1 = "TOT_CReMA"
Range("Q5").Select
ActiveCell.FormulaR1C1 = "CReMA10+...16<=TOT_CReMA"
Range("R5").Select
ActiveCell.FormulaR1C1 = "CReMA11A+11B"
Range("S5").Select
ActiveCell.FormulaR1C1 = "CReMA11"
Range("T5").Select
ActiveCell.FormulaR1C1 = "CReMA11A+11B<=CReMA11"
Range("U5").Select
ActiveCell.FormulaR1C1 = "CReMA13A+13B+13C"
Range("V5").Select
ActiveCell.FormulaR1C1 = "CReMA13"
Range("W5").Select
ActiveCell.FormulaR1C1 = "CReMA13A+13B+13C<=CReMA13"
Range("X5").Select
ActiveCell.FormulaR1C1 = "CReMA12+15+16"
Range("Y5").Select
ActiveCell.FormulaR1C1 = "CREMA12_15_16"
Range("Z5").Select
ActiveCell.FormulaR1C1 = "CReMA12+15+16<=CREMA12_15_16"
Range("AA5").Select
ActiveCell.FormulaR1C1 = "CReMA15A"
Range("AB5").Select
ActiveCell.FormulaR1C1 = "CReMA15"
Range("AC5").Select
ActiveCell.FormulaR1C1 = "CReMA15A<=CReMA15"
Range("AD5").Select
ActiveCell.FormulaR1C1 = "TOT_CEPA+TOT_CReMA"
Range("AE5").Select
ActiveCell.FormulaR1C1 = "TOTAL"
Range("AF5").Select
ActiveCell.FormulaR1C1 = "TOT_CEPA+TOT_CReMA<=TOTAL"
' la police
Sheets("Output Summary").Select
Columns("C:C").Select
Columns("C:AF").Select
Selection.Font.Size = 9
Selection.Font.Size = 8
Range("C5").Select
Range("C5:AF5").Select
With Selection.Font
.Color = -16776961
.TintAndShade = 0
End With
Selection.Font.Bold = True
' Auto Fit Column and Rows OUTPUT
Sheets("Output Summary").Select
Columns("AF:AF").EntireColumn.AutoFit
Columns("AE:AE").EntireColumn.AutoFit
Columns("AD:AD").EntireColumn.AutoFit
Columns("AC:AC").EntireColumn.AutoFit
Columns("AB:AB").EntireColumn.AutoFit
Columns("AA:AA").EntireColumn.AutoFit
Columns("Z:Z").EntireColumn.AutoFit
Columns("Y:Y").EntireColumn.AutoFit
Columns("X:X").EntireColumn.AutoFit
Columns("W:W").EntireColumn.AutoFit
Columns("V:V").EntireColumn.AutoFit
Columns("U:U").EntireColumn.AutoFit
Columns("T:T").EntireColumn.AutoFit
Columns("S:S").EntireColumn.AutoFit
Columns("R:R").EntireColumn.AutoFit
Columns("Q:Q").EntireColumn.AutoFit
Columns("P:P").EntireColumn.AutoFit
Columns("O:O").EntireColumn.AutoFit
Columns("N:N").EntireColumn.AutoFit
Columns("M:M").EntireColumn.AutoFit
Columns("L:L").EntireColumn.AutoFit
Columns("K:K").EntireColumn.AutoFit
Columns("J:J").EntireColumn.AutoFit
Columns("I:I").EntireColumn.AutoFit
Columns("H:H").EntireColumn.AutoFit
Columns("G:G").EntireColumn.AutoFit
Columns("F:F").EntireColumn.AutoFit
Columns("E:E").EntireColumn.AutoFit
Columns("D:D").EntireColumn.AutoFit
Columns("C:C").EntireColumn.AutoFit
' copy of CEPA & CReMA From OUTPUT
Sheets("OUTPUT").Select
Range("AC8:AC308").Select
Selection.Copy
Sheets("Output Summary").Select
Range("D8").Select
ActiveSheet.Paste Link:=True
Sheets("OUTPUT").Select
Range("G8:G308").Select
Selection.Copy
Sheets("Output Summary").Select
Range("F8").Select
ActiveSheet.Paste Link:=True
Sheets("OUTPUT").Select
Range("E8:E308").Select
Selection.Copy
Sheets("Output Summary").Select
Range("G8").Select
ActiveSheet.Paste Link:=True
Sheets("OUTPUT").Select
Range("S8:S308").Select
Selection.Copy
Sheets("Output Summary").Select
Range("J8").Select
ActiveSheet.Paste Link:=True
Sheets("OUTPUT").Select
Range("Y8:Y308").Select
Selection.Copy
Sheets("Output Summary").Select
Range("L8").Select
ActiveSheet.Paste Link:=True
Sheets("OUTPUT").Select
Range("W8:W308").Select
Selection.Copy
Sheets("Output Summary").Select
Range("M8").Select
ActiveSheet.Paste Link:=True
Sheets("OUTPUT").Select
Range("BG8:BG308").Select
Selection.Copy
Sheets("Output Summary").Select
Range("P8").Select
ActiveSheet.Paste Link:=True
Sheets("OUTPUT").Select
Range("AG8:AG308").Select
Selection.Copy
Sheets("Output Summary").Select
Range("S8").Select
ActiveSheet.Paste Link:=True
Sheets("OUTPUT").Select
Range("AM8:AM308").Select
Selection.Copy
Sheets("Output Summary").Select
Range("V8").Select
ActiveSheet.Paste Link:=True
Sheets("OUTPUT").Select
Range("AW8:AW308").Select
Selection.Copy
Sheets("Output Summary").Select
Range("Y8").Select
ActiveSheet.Paste Link:=True
Sheets("OUTPUT").Select
Range("BC8:BC308").Select
Selection.Copy
Sheets("Output Summary").Select
Range("AA8").Select
ActiveSheet.Paste Link:=True
Sheets("OUTPUT").Select
Range("BA8:BA308").Select
Selection.Copy
Sheets("Output Summary").Select
Range("AB8").Select
ActiveSheet.Paste Link:=True
Sheets("OUTPUT").Select
Range("BI8:BI308").Select
Selection.Copy
Sheets("Output Summary").Select
Range("AE8").Select
ActiveSheet.Paste Link:=True
'addition values
'CEPA1-9
Sheets("Output Summary").Select
Range("C8").Select
ActiveCell.Formula = "=SUM(OUTPUT!E8:Q8,OUTPUT!U8,OUTPUT!W8,OUTPUT!AA8)"
Sheets("Output Summary").Select
Range("C8").Select
Selection.AutoFill Destination:=Range("C8:C308"), Type:=xlFillDefault
Range("C8:C308").Select
'CEPA7+8+9
Sheets("Output Summary").Select
Range("I8").Select
ActiveCell.Formula = "=SUM(OUTPUT!U8,OUTPUT!W8,OUTPUT!AA8)"
Sheets("Output Summary").Select
Range("I8").Select
Selection.AutoFill Destination:=Range("I8:I308"), Type:=xlFillDefault
Range("I8:I308").Select
'CReMA10+..16
Sheets("Output Summary").Select
Range("O8").Select
ActiveCell.Formula = "=SUM(OUTPUT!AE8,OUTPUT!AG8,OUTPUT!AY8,OUTPUT!AM8,OUTPUT!AU8,OUTPUT!BA8,OUTPUT!BE8)"
Sheets("Output Summary").Select
Range("O8").Select
Selection.AutoFill Destination:=Range("O8:O308"), Type:=xlFillDefault
Range("O8:O308").Select
'CReMA11A+11B
Sheets("Output Summary").Select
Range("R8").Select
ActiveCell.Formula = "=SUM(OUTPUT!AI8,OUTPUT!AK8)"
Sheets("Output Summary").Select
Range("R8").Select
Selection.AutoFill Destination:=Range("R8:R308"), Type:=xlFillDefault
Range("R8:R308").Select
'CReMA13A+13B+13C
Sheets("Output Summary").Select
Range("U8").Select
ActiveCell.Formula = "=SUM(OUTPUT!AO8,OUTPUT!AQ8,OUTPUT!AS8)"
Sheets("Output Summary").Select
Range("U8").Select
Selection.AutoFill Destination:=Range("U8:U308"), Type:=xlFillDefault
Range("U8:U308").Select
'CReMA12+15+16
Sheets("Output Summary").Select
Range("X8").Select
ActiveCell.Formula = "=SUM(OUTPUT!AY8,OUTPUT!BA8,OUTPUT!BE8)"
Sheets("Output Summary").Select
Range("X8").Select
Selection.AutoFill Destination:=Range("X8:X308"), Type:=xlFillDefault
Range("X8:X308").Select
'TOT_CEPA+TOT_CReMA
Sheets("Output Summary").Select
Range("AD8").Select
ActiveCell.Formula = "=SUM(OUTPUT!AC8,OUTPUT!BG8)"
Sheets("Output Summary").Select
Range("AD8").Select
Selection.AutoFill Destination:=Range("AD8:AD308"), Type:=xlFillDefault
Range("AD8:AD308").Select
' Comparating Values
'CEPA1-9<=TOT_CEPA
Sheets("Output Summary").Select
Range("E8").Select
ActiveCell.Formula = "=IF(C8<=D8,""OK"",""WARNING"")"
Range("E8").Select
Selection.AutoFill Destination:=Range("E8:E308"), Type:=xlFillDefault
Range("E8:E308").Select
'CEPA112_122<=CEPA1
Sheets("Output Summary").Select
Range("H8").Select
ActiveCell.Formula = "=IF(F8<=G8,""OK"",""WARNING"")"
Range("H8").Select
Selection.AutoFill Destination:=Range("H8:H308"), Type:=xlFillDefault
Range("H8:H308").Select
'CEPA7+...0<=CEPA7-9
Sheets("Output Summary").Select
Range("K8").Select
ActiveCell.Formula = "=IF(I8<=J8,""OK"",""WARNING"")"
Range("K8").Select
Selection.AutoFill Destination:=Range("K8:K308"), Type:=xlFillDefault
Range("K8:K308").Select
'CEPA812<=CEPA8
Sheets("Output Summary").Select
Range("N8").Select
ActiveCell.Formula = "=IF(L8<=M8,""OK"",""WARNING"")"
Range("N8").Select
Selection.AutoFill Destination:=Range("N8:N308"), Type:=xlFillDefault
Range("N8:N308").Select
'CReMA10+..16<=TOT_CReMA
Sheets("Output Summary").Select
Range("Q8").Select
ActiveCell.Formula = "=IF(O8<=P8,""OK"",""WARNING"")"
Range("Q8").Select
Selection.AutoFill Destination:=Range("Q8:Q308"), Type:=xlFillDefault
Range("Q8:Q308").Select
'CReMA11A+11B<=CReMA11
Sheets("Output Summary").Select
Range("T8").Select
ActiveCell.Formula = "=IF(R8<=S8,""OK"",""WARNING"")"
Range("T8").Select
Selection.AutoFill Destination:=Range("T8:T308"), Type:=xlFillDefault
Range("T8:T308").Select
'CReMA13A+13B+13C<=CReMA13
Sheets("Output Summary").Select
Range("W8").Select
ActiveCell.Formula = "=IF(U8<=V8,""OK"",""WARNING"")"
Range("W8").Select
Selection.AutoFill Destination:=Range("W8:W308"), Type:=xlFillDefault
Range("W8:W308").Select
'CReMA12+15+16<=CReMA12_15_16
Sheets("Output Summary").Select
Range("Z8").Select
ActiveCell.Formula = "=IF(X8<=Y8,""OK"",""WARNING"")"
Range("Z8").Select
Selection.AutoFill Destination:=Range("Z8:Z308"), Type:=xlFillDefault
Range("Z8:Z308").Select
'CReMA15A<=CReMA15
Sheets("Output Summary").Select
Range("AC8").Select
ActiveCell.Formula = "=IF(AA8<=AB8,""OK"",""WARNING"")"
Range("AC8").Select
Selection.AutoFill Destination:=Range("AC8:AC308"), Type:=xlFillDefault
Range("AC8:AC308").Select
'TOT_CEPA+TOT_CReMA<=TOTAL
Sheets("Output Summary").Select
Range("AF8").Select
ActiveCell.Formula = "=IF(AD8<=AE8,""OK"",""WARNING"")"
Range("AF8").Select
Selection.AutoFill Destination:=Range("AF8:AF308"), Type:=xlFillDefault
Range("AF8:AF308").Select
' regrouping columns
Sheets("Output Summary").Select
Columns("C:D").Select
Selection.Columns.Group
Columns("F:G").Select
Selection.Columns.Group
Columns("I:J").Select
Selection.Columns.Group
Columns("L:M").Select
Selection.Columns.Group
Columns("O:P").Select
Selection.Columns.Group
Columns("R:S").Select
Selection.Columns.Group
Columns("U:V").Select
Selection.Columns.Group
Columns("X:Y").Select
Selection.Columns.GroupBonjour Abakisi, bonjour le forum,
J'ai à peine entrevu ton code mais je peux déjà te conseiller sur quelques points :
• Évite autant que tu le peux les Select inutiles qui ne font que ralentir l'exécution du code.
Si tu crées des variables pour tes onglets tu gagnes par la suite un temps fou. Par exemple ce bout de code :
Sheets("Output Summary").Select
Range("A8:B8").Select
ActiveWindow.SmallScroll Down:=279
Range("A8:B308").Select
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End Withdevient :
Dim OS As Worksheet
Set OS = Worksheets("Output Summary")
with OD.Range(A8:B308").Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End WithC'est toi évidemment qui choisi le nom de tes variables...
• Supprime tous les Scroll qui sont l'enregistrement des mouvements de la roulette de ta souris mais n'apportent rien à l'exécution du code.
Range("J5").Select
ActiveCell.FormulaR1C1 = "CEPA7-9"devient (toujours avec la variable onglet OS) :
OS.Range("J5").Value = "CEPA7-9"• une seule ligne pour Autofit :
OS.columns("AA:AF").Autofit• Pour un copier/coller utilise la syntaxe : Source.Copy Destination. Soit Onglet_source/Plage_source.Copy onglet_destination/Cellule_destination. Sans Select !
Dim O As Worksheet
Dim OS as Worksheet
Set O = Worksheets("Output")
Set OS = Worksheets("Output Summary")
O.Range("AC8:AC308").Copy OS.Range("F8")a
Bonjour ThauThème,
J'y vois déjà beaucoup plus claire, tu viens de me donner un sacré coup de main. Un grand merci à toi.
Je revois tout mon code et je te tiens au courant si cela est fonctionnel.
Très instructif ton post.
Merci encore.
A plus,
Abakisi.