Simplification Macro

Bonjour,

Je suis relativement débutant en VBA et ai développé le code ci-dessous. La macro fonctionne parfaitement. Je souhaiterais maintenant l'optimiser. Quelqu'un aurait-il la gentillesse de m'aider à le simplifier ?

Merci

jp

Sub MAJ_Commandes()
'
' Reporte commandes dans onglet Cons
'
Dim i As Integer
Dim j As Integer
Dim n As Integer

i = 4
j = 5
cnt = 0

Sheets("Cons").Range("A5:M300").Clear
Sheets("Cons").Range("A5:M300").NumberFormat = "#,##0"
Sheets("Cons").Range("I5:I300").Font.Italic = True
Sheets("Cons").Range("I5:I300").HorizontalAlignment = xlCenter
For n = 17 To 52

While Sheets("Commandes").Cells(i, 2) = 1
If Sheets("Commandes").Cells(i, 4) = Sheets("General").Cells(n, 3) Then
Sheets("Cons").Cells(j, 5) = Sheets("Commandes").Cells(i, 3)
Sheets("Flux").Cells(i, 3) = Sheets("Commandes").Cells(i, 3)
Sheets("Cons").Cells(j, 5).Value = Sheets("Commandes").Cells(i, 3)
Sheets("Cons").Cells(j, 6).Value = WorksheetFunction.VLookup(Cells(j, 5).Value, Sheets("Commandes").Range("C4:M300"), 2, False)
Sheets("Cons").Cells(j, 7).Value = WorksheetFunction.VLookup(Cells(j, 5).Value, Sheets("Commandes").Range("C4:M300"), 4, False)
Sheets("Cons").Cells(j, 8).Value = WorksheetFunction.VLookup(Cells(j, 5).Value, Sheets("Commandes").Range("C4:M300"), 5, False)
Sheets("Cons").Cells(j, 9).Value = WorksheetFunction.VLookup(Cells(j, 5).Value, Sheets("Commandes").Range("C4:M300"), 8, False)

Sheets("Cons").Cells(j, 11).Value = WorksheetFunction.VLookup(Cells(j, 5).Value, Sheets("Commandes").Range("C4:M300"), 9, False)
Sheets("Cons").Cells(j, 3).Value = WorksheetFunction.VLookup(Cells(j, 6).Value, Sheets("General").Range("C17:E55"), 3, False)
Sheets("Cons").Cells(j, 12).Value = WorksheetFunction.VLookup(Cells(j, 5).Value, Sheets("Flux").Range("C4:D300"), 2, False)
Sheets("Cons").Cells(j, 5).EntireRow.Select

Selection.Font.Color = RGB(73, 73, 73)

cnt = cnt + 1
Else
j = j - 1

End If

i = i + 1
j = j + 1
Wend

Sheets("Cons").Cells(4, 2) = cnt

i = 4

Next n

Call Format_Cons
Call Format2_Cons
Call Total_Cas_de_Base
Call Total_Budget

End Sub

Sub Format_Cons()
'
' Met en forme l'onglet Cons
'
Dim i As Integer
Dim derli As Long

i = 5
derli = Sheets("Cons").UsedRange.Row + Sheets("Cons").UsedRange.Rows.Count - 1
cnt = 0

For i = 5 To derli
If Not Sheets("Cons").Cells(i, 3) = Sheets("Cons").Cells(i + 1, 3) Then
Sheets("Cons").Cells(i + 1, 3).EntireRow.Insert shift:=xlDown
Sheets("Cons").Cells(i + 1, 3).EntireRow.Insert shift:=xlDown
Sheets("Cons").Cells(i + 1, 3).Value = WorksheetFunction.VLookup(Cells(i - 1, 3).Value, Sheets("General").Range("C9:F13"), 4, True)
Sheets("Cons").Cells(i + 1, 7).Value = "TOTAL"

Sheets("Cons").Cells(i + 1, 11).Value = WorksheetFunction.SumIf(Range("C5", "C300"), Cells(i, 3).Value, Range("K5", "K300"))
Sheets("Cons").Cells(i + 1, 12).Value = WorksheetFunction.SumIf(Range("C5", "C300"), Cells(i, 3).Value, Range("L5", "L300"))

Range(Sheets("Cons").Cells(i + 1, 3), Sheets("Cons").Cells(i + 1, 12)).Select
With Selection.Interior
.Pattern = xlGray25
.PatternThemeColor = xlThemeColorAccent3
.ColorIndex = xlAutomatic
.TintAndShade = 0
.PatternTintAndShade = 0.599963377788629

With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ThemeColor = 7
.TintAndShade = -0.249946592608417
.Weight = xlThin

With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ThemeColor = 7
.TintAndShade = -0.249946592608417
.Weight = xlThin

Selection.Font.Bold = True

i = i + 2
derli = derli + 2
cnt = cnt + 1

End With
End With
End With
End If

Sheets("Cons").Cells(5, 2) = cnt

Next i

End Sub

Sub Format2_Cons()
'
' Met en forme l'onglet Cons
'
Dim i As Integer
Dim derli As Long

i = 5
derli = Sheets("Cons").UsedRange.Row + Sheets("Cons").UsedRange.Rows.Count - 1
cnt = 0

For i = 5 To derli
If Not Sheets("Cons").Cells(i, 6) = Sheets("Cons").Cells(i + 1, 6) And Sheets("Cons").Cells(i, 6) <> "" Then
Sheets("Cons").Cells(i + 1, 6).EntireRow.Insert shift:=xlDown
Sheets("Cons").Cells(i + 1, 6).EntireRow.Insert shift:=xlDown
Sheets("Cons").Cells(i + 1, 4).Value = Sheets("Cons").Cells(i, 6).Value
Sheets("Cons").Cells(i + 1, 7).Value = "Sous-Total"
Sheets("Cons").Cells(i + 1, 10).Value = WorksheetFunction.VLookup(Cells(i + 1, 4).Value, Sheets("General").Range("C17:F55"), 4, False)
Sheets("Cons").Cells(i + 1, 11).Value = WorksheetFunction.SumIf(Range("F5", "F300"), Cells(i + 1, 4).Value, Range("K5", "K300"))
Sheets("Cons").Cells(i + 1, 12).Value = WorksheetFunction.SumIf(Range("F5", "F300"), Cells(i + 1, 4).Value, Range("L5", "L300"))

Range(Sheets("Cons").Cells(i + 1, 4), Sheets("Cons").Cells(i + 1, 12)).Select
Selection.Interior.ColorIndex = xlColorIndexNone
Selection.Font.Color = RGB(70, 130, 180)
Selection.Font.Bold = True
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ThemeColor = 2
.TintAndShade = -0.249946592608417
.Weight = xlThin

i = i + 2
derli = derli + 2
cnt = cnt + 1

End With
End If

Sheets("Cons").Cells(6, 2) = cnt

Next i

End Sub

Sub Total_Budget()
'
'Totalise les coûts
'

Dim i As Integer

i = 3 + Sheets("Cons").Cells(4, 2).Value + Sheets("Cons").Cells(5, 2).Value * 2 + Sheets("Cons").Cells(6, 2).Value * 2

Sheets("Cons").Cells(i + 2, 7).Value = "TOTAL BUDGET"
Sheets("Cons").Cells(i + 2, 10).Value = WorksheetFunction.SumIf(Range("G5", "G300"), "TOTAL", Range("J5", "J300"))
Sheets("Cons").Cells(i + 2, 11).Value = WorksheetFunction.SumIf(Range("G5", "G300"), "TOTAL", Range("K5", "K300"))
Sheets("Cons").Cells(i + 2, 12).Value = WorksheetFunction.SumIf(Range("G5", "G300"), "TOTAL", Range("L5", "L300"))

Range(Sheets("Cons").Cells(i + 2, 7), Sheets("Cons").Cells(i + 2, 12)).Select

With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ThemeColor = 2
.TintAndShade = 0.249946592608417
.Weight = xlMedium

With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ThemeColor = 2
.TintAndShade = 0.249946592608417
.Weight = xlMedium

With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ThemeColor = 2
.TintAndShade = 0.249946592608417
.Weight = xlMedium

With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ThemeColor = 2
.TintAndShade = 0.249946592608417
.Weight = xlMedium

Selection.Font.Bold = True
Selection.Font.Color = RGB(73, 73, 73)

End With
End With
End With
End With

End Sub

Sub Total_Cas_de_Base()
'
'Totalise le Cas de Base
'
Dim i As Integer
Dim derli As Long

i = 5
derli = Sheets("Cons").UsedRange.Row + Sheets("Cons").UsedRange.Rows.Count - 1

For i = 5 To derli
If Sheets("Cons").Cells(i, 7).Value = "Sous-Total" Then
Sheets("Cons").Cells(i, 3).Value = Sheets("Cons").Cells(i - 1, 3).Value

Else
If Sheets("Cons").Cells(i, 7).Value = "TOTAL" Then
Sheets("Cons").Cells(i, 10).Value = WorksheetFunction.SumIf(Range("C5", "C300"), Cells(i - 2, 3).Value, Range("J5", "J300"))

i = i + 1
derli = derli + 1

End If
End If
Next i

End Sub

2 réponses

  1. Bonjour
    Une chose peut-être à modifier, remplacez les 2 lignes suivantes
    Sheets("Cons").Cells(i + 1, 6).EntireRow.Insert shift:=xlDown 
    Sheets("Cons").Cells(i + 1, 6).EntireRow.Insert shift:=xlDown 

    par
    Sheets("Feuil1").Range(Cells(i + 1, 1), Cells(i + 2, 1)).EntireRow.Insert shift:=xlDown
    inutile de répéter plusieurs fois la même action, pour le reste, je ne pense pas que l'on puisse faire mieux. c'est déjà bien optimisé.
    bonne journée
    cdlt
    1. Contributeur
      Bonsoir,

      tu pourrais ajouter en début de macro :
      Application.ScreenUpdating = False
      Application.Calculation = xlCalculationManual

      et en fin:
      Application.ScreenUpdating = True
      Application.Calculation = xlCalculationAutomatic
      Calculate

      Si tu as de formules qui peuvent évoluer selon ta macro, et que tu doives réutiliser le résultat dans la macro penser à mettre un Calculate avant.

      eric