Optimisation de calcul VBA

Le 10/05/2017 à 17:05

Bonjour,

J'ai fait des macros VBA pour l'automatisation de traitement de données, je dévais à partir d'un documents sélectionner que quelque colonne (dont j'ai besoin) la sélection des colonne se fait selon un code (je doit sélectionner que les projets de 2017 alors que dans mon doc y'a même ceux de 2016 ) les données doivent êtres classifié dans d'autres feuilles selon leur nom , j'ai une feuil DZ, EFL ... après je doit calculer le pourcentage des valeur que j'ai extrait, là j'arrive à faire tout ce qui étais demandé sauf que mon doc est très lent, et à chaque fois que je l'ouvre je dois redémarrer Excel, du coup j'ai pensé à l'optimiser, si quelqu'un auras une idées Merci Beaucoup

Je vous met un fichier test ci-joint avec les macros que j'ai utilisé pour que vous aurez une idée un peu plus clair.

Merci D'avance

Sub Open_Doc()

Dim MaPlage As Range

Dim Fichier, WbkCopy As Workbook, WbkColle As Workbook

Dim Colonnes(), Col As Integer, Resultat As Variant

'On attribue à la variable WbkColle le fichier actuel (celui qui contient la macro)

Set WbkColle = ThisWorkbook

'Sélection du fichier

Fichier = Application.GetOpenFilename("Fichiers Excels, *.xls*")

'En cas de clic sur "ANNULER"

If Fichier <> False Then

'On ouvre le fichier en question

Set WbkCopy = Workbooks.Open(Fichier)

End If

Set WbkCopy = Nothing

Set WbkColle = Nothing

With Workbooks("Liste_des_Budgets_-_Vue_Services_d_imputation_filtrees_sur_Etat.xlsx").Worksheets("Liste_des_Budgets_-_Vue_Servic")

Set MaPlage = Application.Union(.Range("A1:A1000"), .Range("B1:B1000"), .Range("C1:C1000"), .Range("D1:D1000"), .Range("E1:E1000"), .Range("F1:F1000"), .Range("G1:G1000"), .Range("H1:H1000"), .Range("I1:I1000"), .Range("J1:J1000"), .Range("K1:K1000"), .Range("L1:L1000"), .Range("M1:M1000"), .Range("N1:N1000"), .Range("O1:O1000"), .Range("P1:P1000"), .Range("Q1:Q1000"), .Range("R1:R1000"), .Range("S1:S1000"), .Range("T1:T1000"), .Range("U1:U1000"), .Range("V1:V1000"), .Range("W1:W1000"), .Range("X1:X1000"), .Range("Y1:Y1000"), .Range("Z1:Z1000"))

End With

MaPlage.Copy

Workbooks("Liste_des_Budgets_-_(SIE).xlsm").Worksheets("Liste_des_Budgets_-_Vue_Service").Activate 'ou Select

Range("A1").Select

ActiveSheet.Paste

End Sub

Sub Tri_Data()

Range("A:A,C:C,D:D,E:E,F:F,G:G,L:L,M:M").Select

Selection.Copy

Sheets("SIE-Etat-Budgets").Select

Range("A1").Select

ActiveSheet.Paste

Range("A1:J1").Select

With Selection.Interior

.Pattern = xlSolid

.PatternColor = 0

.ThemeColor = xlThemeColorAccent1

.TintAndShade = 0

.PatternTintAndShade = 0

End With

Selection.Font.Bold = True

With Selection.Font

.ThemeColor = xlThemeColorDark1

.TintAndShade = 0

End With

Range("A1").Select

End Sub

Sub Calcul_Pourcentage_Budget()

Dim Valeur As Integer

Columns("J:J").Select

ActiveWorkbook.Worksheets("SIE-Etat-Budgets").Sort.SortFields.Clear

ActiveWorkbook.Worksheets("SIE-Etat-Budgets").Sort.SortFields.Add Key:=Range( _

"J1"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _

xlSortTextAsNumbers

With ActiveWorkbook.Worksheets("SIE-Etat-Budgets").Sort

.SetRange ActiveSheet.Range("A2:J" & Range("A" & Rows.Count).End(xlUp).Row)

.Header = xlNo

.MatchCase = False

.Orientation = xlTopToBottom

.SortMethod = xlPinYin

.Apply

End With

Valeur = Sheets("SIE-Etat-Budgets").Range("A" & Rows.Count).End(xlUp).Row

For i = 2 To Valeur

If Sheets("SIE-Etat-Budgets").Range("J" & i).Value > 1.00000000001 Then

Sheets("SIE-Etat-Budgets").Range("J" & i).Interior.ColorIndex = 3

ElseIf Sheets("SIE-Etat-Budgets").Range("J" & i).Value = 0 Then

Sheets("SIE-Etat-Budgets").Range("J" & i).Interior.ColorIndex = 36

ElseIf Sheets("SIE-Etat-Budgets").Range("J" & i).Value < 0.999999999999 And Sheets("SIE-Etat-Budgets").Range("J" & i).Value <> 0 Then

Sheets("SIE-Etat-Budgets").Range("J" & i).Interior.ColorIndex = 44

Else: Sheets("SIE-Etat-Budgets").Range("J" & i).Value = 1

Sheets("SIE-Etat-Budgets").Range("J" & i).Interior.ColorIndex = 4

End If

Next i

End Sub

Sub Classifier_Data()

Range("A:J").Select

Selection.Copy

Sheets("SIE-Etat-Budgets").Select

Range("A1").Select

ActiveSheet.Paste

Range("A1:J1").Select

With Selection.Interior

.Pattern = xlSolid

.PatternColor = 0

.ThemeColor = xlThemeColorAccent1

.TintAndShade = 0

.PatternTintAndShade = 0

End With

Selection.Font.Bold = True

With Selection.Font

.ThemeColor = xlThemeColorDark1

.TintAndShade = 0

End With

Range("A1").Select

'SIE-Total-Budgets

Sheets("SIE-Etat-Budgets").Select

Columns("B:B").Select

Selection.AutoFilter

ActiveSheet.Range("$B$1:$B$10000").AutoFilter Field:=1, Criteria1:="=17-**-*SE-*", _

Operator:=xlAnd

Range("A:A,B:B,C:C,D:D,E:E,F:F,G:G,H:H,I:I,J:J").Select

Selection.Copy

Sheets("SIE-Total-Budgets").Select

Range("A1").Select

ActiveSheet.Paste

Sheets("SIE-Etat-Budgets").Select

Application.CutCopyMode = False

Selection.AutoFilter

Range("A1:J1").Select

With Selection.Interior

.Pattern = xlSolid

.PatternColor = 0

.ThemeColor = xlThemeColorAccent1

.TintAndShade = 0

.PatternTintAndShade = 0

End With

Selection.Font.Bold = True

With Selection.Font

.ThemeColor = xlThemeColorDark1

.TintAndShade = 0

End With

Range("A1").Select

'DZ

Sheets("SIE-Etat-Budgets").Select

Columns("B:B").Select

Selection.AutoFilter

ActiveSheet.Range("$B$1:$B$10000").AutoFilter Field:=1, Criteria1:="=17-DZ-*SE-*", _

Operator:=xlAnd

Range("A:A,B:B,C:C,D:D,E:E,F:F,G:G,H:H,I:I,J:J").Select

Selection.Copy

Sheets("DZ").Select

Range("A1").Select

ActiveSheet.Paste

Sheets("SIE-Etat-Budgets").Select

Application.CutCopyMode = False

Selection.AutoFilter

Range("A1:J1").Select

With Selection.Interior

.Pattern = xlSolid

.PatternColor = 0

.ThemeColor = xlThemeColorAccent1

.TintAndShade = 0

.PatternTintAndShade = 0

End With

Selection.Font.Bold = True

With Selection.Font

.ThemeColor = xlThemeColorDark1

.TintAndShade = 0

End With

Range("A1").Select

'EFL

Sheets("SIE-Etat-Budgets").Select

Columns("B:B").Select

Selection.AutoFilter

ActiveSheet.Range("$B$1:$B$10000").AutoFilter Field:=1, Criteria1:="=17-EFL-*SE-*", _

Operator:=xlAnd

Range("A:A,B:B,C:C,D:D,E:E,F:F,G:G,H:H,I:I,J:J").Select

Selection.Copy

Sheets("EFL").Select

Range("A1").Select

ActiveSheet.Paste

Sheets("SIE-Etat-Budgets").Select

Application.CutCopyMode = False

Selection.AutoFilter

Range("A1:J1").Select

With Selection.Interior

.Pattern = xlSolid

.PatternColor = 0

.ThemeColor = xlThemeColorAccent1

.TintAndShade = 0

.PatternTintAndShade = 0

End With

Selection.Font.Bold = True

With Selection.Font

.ThemeColor = xlThemeColorDark1

.TintAndShade = 0

End With

Range("A1").Select

'EL

Sheets("SIE-Etat-Budgets").Select

Columns("B:B").Select

Selection.AutoFilter

ActiveSheet.Range("$B$1:$B$10000").AutoFilter Field:=1, Criteria1:="=17-EL-*SE-*", _

Operator:=xlAnd

Range("A:A,B:B,C:C,D:D,E:E,F:F,G:G,H:H,I:I,J:J").Select

Selection.Copy

Sheets("EL").Select

Range("A1").Select

ActiveSheet.Paste

Sheets("SIE-Etat-Budgets").Select

Application.CutCopyMode = False

Selection.AutoFilter

Range("A1:J1").Select

With Selection.Interior

.Pattern = xlSolid

.PatternColor = 0

.ThemeColor = xlThemeColorAccent1

.TintAndShade = 0

.PatternTintAndShade = 0

End With

Selection.Font.Bold = True

With Selection.Font

.ThemeColor = xlThemeColorDark1

.TintAndShade = 0

End With

Range("A1").Select

'ELSG

Sheets("SIE-Etat-Budgets").Select

Columns("B:B").Select

Selection.AutoFilter

ActiveSheet.Range("$B$1:$B$10000").AutoFilter Field:=1, Criteria1:="=17-ELSG-*SE-*", _

Operator:=xlAnd

Range("A:A,B:B,C:C,D:D,E:E,F:F,G:G,H:H,I:I,J:J").Select

Selection.Copy

Sheets("ELSG").Select

Range("A1").Select

ActiveSheet.Paste

Sheets("SIE-Etat-Budgets").Select

Application.CutCopyMode = False

Selection.AutoFilter

Range("A1:J1").Select

With Selection.Interior

.Pattern = xlSolid

.PatternColor = 0

.ThemeColor = xlThemeColorAccent1

.TintAndShade = 0

.PatternTintAndShade = 0

End With

Selection.Font.Bold = True

With Selection.Font

.ThemeColor = xlThemeColorDark1

.TintAndShade = 0

End With

Range("A1").Select

'DZ FSE

Sheets("SIE-Etat-Budgets").Select

Columns("B:B").Select

Selection.AutoFilter

ActiveSheet.Range("$B$1:$B$10000").AutoFilter Field:=1, Criteria1:="=17-DZ-FSE-*", _

Operator:=xlAnd

Range("A:A,B:B,C:C,D:D,E:E,F:F,G:G,H:H,I:I,J:J").Select

Selection.Copy

Sheets("DZ FSE").Select

Range("A1").Select

ActiveSheet.Paste

Sheets("SIE-Etat-Budgets").Select

Application.CutCopyMode = False

Selection.AutoFilter

Range("A1:J1").Select

With Selection.Interior

.Pattern = xlSolid

.PatternColor = 0

.ThemeColor = xlThemeColorAccent1

.TintAndShade = 0

.PatternTintAndShade = 0

End With

Selection.Font.Bold = True

With Selection.Font

.ThemeColor = xlThemeColorDark1

.TintAndShade = 0

End With

Range("A1").Select

'DZ BSE

Sheets("SIE-Etat-Budgets").Select

Columns("B:B").Select

Selection.AutoFilter

ActiveSheet.Range("$B$1:$B$10000").AutoFilter Field:=1, Criteria1:="=17-DZ-BSE-*", _

Operator:=xlAnd

Range("A:A,B:B,C:C,D:D,E:E,F:F,G:G,H:H,I:I,J:J").Select

Selection.Copy

Sheets("DZ BSE").Select

Range("A1").Select

ActiveSheet.Paste

Sheets("SIE-Etat-Budgets").Select

Application.CutCopyMode = False

Selection.AutoFilter

Range("A1:J1").Select

With Selection.Interior

.Pattern = xlSolid

.PatternColor = 0

.ThemeColor = xlThemeColorAccent1

.TintAndShade = 0

.PatternTintAndShade = 0

End With

Selection.Font.Bold = True

With Selection.Font

.ThemeColor = xlThemeColorDark1

.TintAndShade = 0

End With

Range("A1").Select

'EFL FSE

Sheets("SIE-Etat-Budgets").Select

Columns("B:B").Select

Selection.AutoFilter

ActiveSheet.Range("$B$1:$B$10000").AutoFilter Field:=1, Criteria1:="=17-EFL-FSE-*", _

Operator:=xlAnd

Range("A:A,B:B,C:C,D:D,E:E,F:F,G:G,H:H,I:I,J:J").Select

Selection.Copy

Sheets("EFL FSE").Select

Range("A1").Select

ActiveSheet.Paste

Sheets("SIE-Etat-Budgets").Select

Application.CutCopyMode = False

Selection.AutoFilter

Range("A1:J1").Select

With Selection.Interior

.Pattern = xlSolid

.PatternColor = 0

.ThemeColor = xlThemeColorAccent1

.TintAndShade = 0

.PatternTintAndShade = 0

End With

Selection.Font.Bold = True

With Selection.Font

.ThemeColor = xlThemeColorDark1

.TintAndShade = 0

End With

Range("A1").Select

'EFL BSE

Sheets("SIE-Etat-Budgets").Select

Columns("B:B").Select

Selection.AutoFilter

ActiveSheet.Range("$B$1:$B$10000").AutoFilter Field:=1, Criteria1:="=17-EFL-BSE-*", _

Operator:=xlAnd

Range("A:A,B:B,C:C,D:D,E:E,F:F,G:G,H:H,I:I,J:J").Select

Selection.Copy

Sheets("EFL BSE").Select

Range("A1").Select

ActiveSheet.Paste

Sheets("SIE-Etat-Budgets").Select

Application.CutCopyMode = False

Selection.AutoFilter

Range("A1:J1").Select

With Selection.Interior

.Pattern = xlSolid

.PatternColor = 0

.ThemeColor = xlThemeColorAccent1

.TintAndShade = 0

.PatternTintAndShade = 0

End With

Selection.Font.Bold = True

With Selection.Font

.ThemeColor = xlThemeColorDark1

.TintAndShade = 0

End With

Range("A1").Select

'EL FSE

Sheets("SIE-Etat-Budgets").Select

Columns("B:B").Select

Selection.AutoFilter

ActiveSheet.Range("$B$1:$B$10000").AutoFilter Field:=1, Criteria1:="=17-EL-FSE-*", _

Operator:=xlAnd

Range("A:A,B:B,C:C,D:D,E:E,F:F,G:G,H:H,I:I,J:J").Select

Selection.Copy

Sheets("EL FSE").Select

Range("A1").Select

ActiveSheet.Paste

Sheets("SIE-Etat-Budgets").Select

Application.CutCopyMode = False

Selection.AutoFilter

Range("A1:J1").Select

With Selection.Interior

.Pattern = xlSolid

.PatternColor = 0

.ThemeColor = xlThemeColorAccent1

.TintAndShade = 0

.PatternTintAndShade = 0

End With

Selection.Font.Bold = True

With Selection.Font

.ThemeColor = xlThemeColorDark1

.TintAndShade = 0

End With

Range("A1").Select

'EL BSE

Sheets("SIE-Etat-Budgets").Select

Columns("B:B").Select

Selection.AutoFilter

ActiveSheet.Range("$B$1:$B$10000").AutoFilter Field:=1, Criteria1:="=17-EL-BSE-*", _

Operator:=xlAnd

Range("A:A,B:B,C:C,D:D,E:E,F:F,G:G,H:H,I:I,J:J").Select

Selection.Copy

Sheets("EL BSE").Select

Range("A1").Select

ActiveSheet.Paste

Sheets("SIE-Etat-Budgets").Select

Application.CutCopyMode = False

Selection.AutoFilter

Range("A1:J1").Select

With Selection.Interior

.Pattern = xlSolid

.PatternColor = 0

.ThemeColor = xlThemeColorAccent1

.TintAndShade = 0

.PatternTintAndShade = 0

End With

Selection.Font.Bold = True

With Selection.Font

.ThemeColor = xlThemeColorDark1

.TintAndShade = 0

End With

Range("A1").Select

'ELSG FSE

Sheets("SIE-Etat-Budgets").Select

Columns("B:B").Select

Selection.AutoFilter

ActiveSheet.Range("$B$1:$B$10000").AutoFilter Field:=1, Criteria1:="=17-ELSG-FSE-*", _

Operator:=xlAnd

Range("A:A,B:B,C:C,D:D,E:E,F:F,G:G,H:H,I:I,J:J").Select

Selection.Copy

Sheets("ELSG FSE").Select

Range("A1").Select

ActiveSheet.Paste

Sheets("SIE-Etat-Budgets").Select

Application.CutCopyMode = False

Selection.AutoFilter

Range("A1:J1").Select

With Selection.Interior

.Pattern = xlSolid

.PatternColor = 0

.ThemeColor = xlThemeColorAccent1

.TintAndShade = 0

.PatternTintAndShade = 0

End With

Selection.Font.Bold = True

With Selection.Font

.ThemeColor = xlThemeColorDark1

.TintAndShade = 0

End With

Range("A1").Select

'ELSG BSE

Sheets("SIE-Etat-Budgets").Select

Columns("B:B").Select

Selection.AutoFilter

ActiveSheet.Range("$B$1:$B$10000").AutoFilter Field:=1, Criteria1:="=17-ELSG-BSE-*", _

Operator:=xlAnd

Range("A:A,B:B,C:C,D:D,E:E,F:F,G:G,H:H,I:I,J:J").Select

Selection.Copy

Sheets("ELSG BSE").Select

Range("A1").Select

ActiveSheet.Paste

Sheets("SIE-Etat-Budgets").Select

Application.CutCopyMode = False

Selection.AutoFilter

Range("A1:J1").Select

With Selection.Interior

.Pattern = xlSolid

.PatternColor = 0

.ThemeColor = xlThemeColorAccent1

.TintAndShade = 0

.PatternTintAndShade = 0

End With

Selection.Font.Bold = True

With Selection.Font

.ThemeColor = xlThemeColorDark1

.TintAndShade = 0

End With

Range("A1").Select

End Sub

Sub Somme_Budgets()

Dim x As Integer, L As Integer, nombre_de_colonne As Integer

'SIE-Total-Budgets

Sheets("SIE-Total-Budgets").Select

nombre_de_colonne = 9

For x = 6 To nombre_de_colonne

L = Cells(Rows.Count, x).End(xlUp).Row

Cells(L + 1, x).Formula = "=SUM(" & Cells(2, x).Address & ":" & Cells(L, x).Address & ")"

Next

'DZ

Sheets("DZ").Select

nombre_de_colonne = 9

For x = 6 To nombre_de_colonne

L = Cells(Rows.Count, x).End(xlUp).Row

Cells(L + 1, x).Formula = "=SUM(" & Cells(2, x).Address & ":" & Cells(L, x).Address & ")"

Next

'EFL

Sheets("EFL").Select

nombre_de_colonne = 9

For x = 6 To nombre_de_colonne

L = Cells(Rows.Count, x).End(xlUp).Row

Cells(L + 1, x).Formula = "=SUM(" & Cells(2, x).Address & ":" & Cells(L, x).Address & ")"

Next

'EL

Sheets("EL").Select

nombre_de_colonne = 9

For x = 6 To nombre_de_colonne

L = Cells(Rows.Count, x).End(xlUp).Row

Cells(L + 1, x).Formula = "=SUM(" & Cells(2, x).Address & ":" & Cells(L, x).Address & ")"

Next

'ELSG

Sheets("ELSG").Select

nombre_de_colonne = 9

For x = 6 To nombre_de_colonne

L = Cells(Rows.Count, x).End(xlUp).Row

Cells(L + 1, x).Formula = "=SUM(" & Cells(2, x).Address & ":" & Cells(L, x).Address & ")"

Next

'DZ BSE

Sheets("DZ BSE").Select

nombre_de_colonne = 9

For x = 6 To nombre_de_colonne

L = Cells(Rows.Count, x).End(xlUp).Row

Cells(L + 1, x).Formula = "=SUM(" & Cells(2, x).Address & ":" & Cells(L, x).Address & ")"

Next

'DZ FSE

Sheets("DZ FSE").Select

nombre_de_colonne = 9

For x = 6 To nombre_de_colonne

L = Cells(Rows.Count, x).End(xlUp).Row

Cells(L + 1, x).Formula = "=SUM(" & Cells(2, x).Address & ":" & Cells(L, x).Address & ")"

Next

'EFL FSE

Sheets("EFL FSE").Select

nombre_de_colonne = 9

For x = 6 To nombre_de_colonne

L = Cells(Rows.Count, x).End(xlUp).Row

Cells(L + 1, x).Formula = "=SUM(" & Cells(2, x).Address & ":" & Cells(L, x).Address & ")"

Next

'EFL BSE

Sheets("EFL BSE").Select

nombre_de_colonne = 9

For x = 6 To nombre_de_colonne

L = Cells(Rows.Count, x).End(xlUp).Row

Cells(L + 1, x).Formula = "=SUM(" & Cells(2, x).Address & ":" & Cells(L, x).Address & ")"

Next

'EL FSE

Sheets("EL FSE").Select

nombre_de_colonne = 9

For x = 6 To nombre_de_colonne

L = Cells(Rows.Count, x).End(xlUp).Row

Cells(L + 1, x).Formula = "=SUM(" & Cells(2, x).Address & ":" & Cells(L, x).Address & ")"

Next

'EL BSE

Sheets("EL BSE").Select

nombre_de_colonne = 9

For x = 6 To nombre_de_colonne

L = Cells(Rows.Count, x).End(xlUp).Row

Cells(L + 1, x).Formula = "=SUM(" & Cells(2, x).Address & ":" & Cells(L, x).Address & ")"

Next

'ELSG FSE

Sheets("ELSG FSE").Select

nombre_de_colonne = 9

For x = 6 To nombre_de_colonne

L = Cells(Rows.Count, x).End(xlUp).Row

Cells(L + 1, x).Formula = "=SUM(" & Cells(2, x).Address & ":" & Cells(L, x).Address & ")"

Next

'ELSG BSE

Sheets("ELSG BSE").Select

nombre_de_colonne = 9

For x = 6 To nombre_de_colonne

L = Cells(Rows.Count, x).End(xlUp).Row

Cells(L + 1, x).Formula = "=SUM(" & Cells(2, x).Address & ":" & Cells(L, x).Address & ")"

Next

End Sub

Sub Derniere()

Dim wks As Worksheet

Set wks = Worksheets("Bilan")

'Budget SIE

For x = 3 To 3

sWks = Sheets(x).Name

If sWks <> "Bilan" Then

With Worksheets(sWks)

DerniereCellule0 = .Cells(.Rows.Count, "I").End(xlUp).Value

DerniereCellule01 = .Cells(.Rows.Count, "H").End(xlUp).Value

DerniereCellule02 = .Cells(.Rows.Count, "G").End(xlUp).Value

DerniereCellule03 = .Cells(.Rows.Count, "F").End(xlUp).Value

End With

'Recopier la valeur dans une nouvelle cellule

Sheets("Bilan").Range("A6").Value = DerniereCellule03

Sheets("Bilan").Range("D6").Value = DerniereCellule03

Sheets("Bilan").Range("A10").Value = DerniereCellule01 + DerniereCellule02

Sheets("Bilan").Range("B10").Value = DerniereCellule0

End If

Next

'Budget SIG SFE & BSE

For x = 16 To 16

sWks = Sheets(x).Name

With Worksheets(sWks)

DerniereCellule16 = .Cells(.Rows.Count, "I").End(xlUp).Value

DerniereCellule016 = .Cells(.Rows.Count, "H").End(xlUp).Value

DerniereCellule0016 = .Cells(.Rows.Count, "G").End(xlUp).Value

End With

'Recopier la valeur dans une nouvelle cellule

Cells(10, 4).Formula = "=SUM(" & Cells(15, 4).Address & ":" & Cells(20, 4).Address & ":" & Cells(25, 4).Address & ":" & Cells(30, 4).Address & ")"

Cells(10, 5).Formula = "=SUM(" & Cells(15, 5).Address & ":" & Cells(20, 5).Address & ":" & Cells(25, 5).Address & ":" & Cells(30, 5).Address & ")"

Cells(10, 7).Formula = "=SUM(" & Cells(15, 7).Address & ":" & Cells(20, 7).Address & ":" & Cells(25, 7).Address & ":" & Cells(30, 7).Address & ")"

Cells(10, 8).Formula = "=SUM(" & Cells(15, 8).Address & ":" & Cells(20, 8).Address & ":" & Cells(25, 8).Address & ":" & Cells(30, 8).Address & ")"

Next

'Budget DZ

For x = 4 To 4

sWks = Sheets(x).Name

If sWks <> "Bilan" Then

With Worksheets(sWks)

DerniereCellule1 = .Cells(.Rows.Count, "H").End(xlUp).Value

DerniereCellule2 = .Cells(.Rows.Count, "G").End(xlUp).Value

DerniereCellule3 = .Cells(.Rows.Count, "I").End(xlUp).Value

End With

'Recopier la valeur dans une nouvelle cellule

Sheets("Bilan").Range("A15").Value = DerniereCellule1 + DerniereCellule2

Sheets("Bilan").Range("B15").Value = DerniereCellule3

End If

Next

'Budget DZ FSE

For x = 8 To 8

sWks = Sheets(x).Name

If sWks <> "Bilan" Then

With Worksheets(sWks)

DerniereCellule01 = .Cells(.Rows.Count, "H").End(xlUp).Value

DerniereCellule02 = .Cells(.Rows.Count, "G").End(xlUp).Value

DerniereCellule03 = .Cells(.Rows.Count, "I").End(xlUp).Value

End With

'Recopier la valeur dans une nouvelle cellule

Sheets("Bilan").Range("D15").Value = DerniereCellule01 + DerniereCellule02

Sheets("Bilan").Range("E15").Value = DerniereCellule03

End If

Next

'Budget DZ BSE

For x = 9 To 9

sWks = Sheets(x).Name

If sWks <> "Bilan" Then

With Worksheets(sWks)

DerniereCellule001 = .Cells(.Rows.Count, "H").End(xlUp).Value

DerniereCellule002 = .Cells(.Rows.Count, "G").End(xlUp).Value

DerniereCellule003 = .Cells(.Rows.Count, "I").End(xlUp).Value

End With

'Recopier la valeur dans une nouvelle cellule

Sheets("Bilan").Range("G15").Value = DerniereCellule001 + DerniereCellule002

Sheets("Bilan").Range("H15").Value = DerniereCellule003

End If

Next

'Budget EFL

For x = 5 To 5

sWks = Sheets(x).Name

If sWks <> "Bilan" Then

With Worksheets(sWks)

DerniereCellule4 = .Cells(.Rows.Count, "H").End(xlUp).Value

DerniereCellule5 = .Cells(.Rows.Count, "G").End(xlUp).Value

DerniereCellule6 = .Cells(.Rows.Count, "I").End(xlUp).Value

End With

'Recopier la valeur dans une nouvelle cellule

Sheets("Bilan").Range("A20").Value = DerniereCellule4 + DerniereCellule5

Sheets("Bilan").Range("B20").Value = DerniereCellule6

End If

Next

'Budget EFL FSE

For x = 10 To 10

sWks = Sheets(x).Name

If sWks <> "Bilan" Then

With Worksheets(sWks)

DerniereCellule04 = .Cells(.Rows.Count, "H").End(xlUp).Value

DerniereCellule05 = .Cells(.Rows.Count, "G").End(xlUp).Value

DerniereCellule06 = .Cells(.Rows.Count, "I").End(xlUp).Value

End With

'Recopier la valeur dans une nouvelle cellule

Sheets("Bilan").Range("D20").Value = DerniereCellule04 + DerniereCellule05

Sheets("Bilan").Range("E20").Value = DerniereCellule06

End If

Next

'Budget EFL BSE

For x = 11 To 11

sWks = Sheets(x).Name

If sWks <> "Bilan" Then

With Worksheets(sWks)

DerniereCellule004 = .Cells(.Rows.Count, "H").End(xlUp).Value

DerniereCellule005 = .Cells(.Rows.Count, "G").End(xlUp).Value

DerniereCellule006 = .Cells(.Rows.Count, "I").End(xlUp).Value

End With

'Recopier la valeur dans une nouvelle cellule

Sheets("Bilan").Range("G20").Value = DerniereCellule004 + DerniereCellule005

Sheets("Bilan").Range("H20").Value = DerniereCellule006

End If

Next

'Budget EL

For x = 6 To 6

sWks = Sheets(x).Name

If sWks <> "Bilan" Then

With Worksheets(sWks)

DerniereCellule7 = .Cells(.Rows.Count, "H").End(xlUp).Value

DerniereCellule8 = .Cells(.Rows.Count, "G").End(xlUp).Value

DerniereCellule9 = .Cells(.Rows.Count, "I").End(xlUp).Value

End With

'Recopier la valeur dans une nouvelle cellule

Sheets("Bilan").Range("A25").Value = DerniereCellule7 + DerniereCellule8

Sheets("Bilan").Range("B25").Value = DerniereCellule9

End If

Next

'Budget EL FSE

For x = 12 To 12

sWks = Sheets(x).Name

If sWks <> "Bilan" Then

With Worksheets(sWks)

DerniereCellule07 = .Cells(.Rows.Count, "H").End(xlUp).Value

DerniereCellule08 = .Cells(.Rows.Count, "G").End(xlUp).Value

DerniereCellule09 = .Cells(.Rows.Count, "I").End(xlUp).Value

End With

'Recopier la valeur dans une nouvelle cellule

Sheets("Bilan").Range("D25").Value = DerniereCellule07 + DerniereCellule08

Sheets("Bilan").Range("E25").Value = DerniereCellule09

End If

Next

'Budget EL BSE

For x = 13 To 13

sWks = Sheets(x).Name

If sWks <> "Bilan" Then

With Worksheets(sWks)

DerniereCellule007 = .Cells(.Rows.Count, "H").End(xlUp).Value

DerniereCellule008 = .Cells(.Rows.Count, "G").End(xlUp).Value

DerniereCellule009 = .Cells(.Rows.Count, "I").End(xlUp).Value

End With

'Recopier la valeur dans une nouvelle cellule

Sheets("Bilan").Range("G25").Value = DerniereCellule007 + DerniereCellule008

Sheets("Bilan").Range("H25").Value = DerniereCellule009

End If

Next

'Budget ELSG

For x = 7 To 7

sWks = Sheets(x).Name

If sWks <> "Bilan" Then

With Worksheets(sWks)

DerniereCellule10 = .Cells(.Rows.Count, "H").End(xlUp).Value

DerniereCellule11 = .Cells(.Rows.Count, "G").End(xlUp).Value

DerniereCellule12 = .Cells(.Rows.Count, "I").End(xlUp).Value

End With

'Recopier la valeur dans une nouvelle cellule

Sheets("Bilan").Range("A30").Value = DerniereCellule10 + DerniereCellule11

Sheets("Bilan").Range("B30").Value = DerniereCellule12

End If

Next

'Budget ELSG FSE

For x = 14 To 14

sWks = Sheets(x).Name

If sWks <> "Bilan" Then

With Worksheets(sWks)

DerniereCellule010 = .Cells(.Rows.Count, "H").End(xlUp).Value

DerniereCellule011 = .Cells(.Rows.Count, "G").End(xlUp).Value

DerniereCellule012 = .Cells(.Rows.Count, "I").End(xlUp).Value

End With

'Recopier la valeur dans une nouvelle cellule

Sheets("Bilan").Range("D30").Value = DerniereCellule010 + DerniereCellule011

Sheets("Bilan").Range("E30").Value = DerniereCellule012

End If

Next

'Budget ELSG BSE

For x = 15 To 15

sWks = Sheets(x).Name

If sWks <> "Bilan" Then

With Worksheets(sWks)

DerniereCellule0010 = .Cells(.Rows.Count, "H").End(xlUp).Value

DerniereCellule0011 = .Cells(.Rows.Count, "G").End(xlUp).Value

DerniereCellule0012 = .Cells(.Rows.Count, "I").End(xlUp).Value

End With

'Recopier la valeur dans une nouvelle cellule

Sheets("Bilan").Range("G30").Value = DerniereCellule0010 + DerniereCellule0011

Sheets("Bilan").Range("H30").Value = DerniereCellule0012

End If

Next

End Sub

29liste-des-budgets-sie.xlsm (139.08 Ko)
Le 10/05/2017 à 22:19

Bonjour,

si vous mettez à la place de ceci :

Set MaPlage = Application.Union(.Range("A1:A1000"), .Range("B1:B1000"), .Range("C1:C1000"), .Range("D1:D1000"), .Range("E1:E1000"), .Range("F1:F1000"), .Range("G1:G1000"), .Range("H1:H1000"), .Range("I1:I1000"), .Range("J1:J1000"), .Range("K1:K1000"), .Range("L1:L1000"), .Range("M1:M1000"), .Range("N1:N1000"), .Range("O1:O1000"), .Range("P1:P1000"), .Range("Q1:Q1000"), .Range("R1:R1000"), .Range("S1:S1000"), .Range("T1:T1000"), .Range("U1:U1000"), .Range("V1:V1000"), .Range("W1:W1000"), .Range("X1:X1000"), .Range("Y1:Y1000"), .Range("Z1:Z1000"))

par :

Set MaPlage = .Range("A1:Z1000")

si vous mettez à la place de ceci :

Range("A:A,B:B,C:C,D:D,E:E,F:F,G:G,H:H,I:I,J:J").Select

par :

Range("A:J").Select

si vous mettez à la place de ceci :

Workbooks("Liste_des_Budgets_-_(SIE).xlsm").Worksheets("Liste_des_Budgets_-_Vue_Service").Activate 'ou Select
 Range("A1").Select
 ActiveSheet.Paste

par :

Workbooks("Liste_des_Budgets_-_(SIE).xlsm").Worksheets("Liste_des_Budgets_-_Vue_Service").Range("A1").Select
 ActiveSheet.Paste

et en début de procédure :

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual

et en fin de chaque procédure:

Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.ScreenUpdating = True

C'est un début...

@ bientôt

LouReeD

Le 11/05/2017 à 03:02

Bonjour,

Je voudrais juste faire remarquer qu'avec une telle demande, citer un tel volume de code sans même le mettre sous balise Code, j'ai tendance à penser que c'est ce moquer du monde ! En conséquence, je ne commence même pas à le lire...

Mais l'ayant tout de même suffisamment aperçu de loin pour voir qu'il s'agit de code enregistré, il est facile de dire qu'il est intégralement à réécrire, d'autant plus que certains des éléments ne relevant pas d'enregistrement sont un défi au bon sens !

Qu'il soit lent, on a tout fait pour, c'est dans l'ordre des choses.

Cordialement.

Le 15/05/2017 à 16:47

Bonjour LouReeD, Bonjour MFerrand

@ LouReeD Merci pour vos réponses, ça m'aide beaucoup, j'essai de suivre votre solution

@MFerrand , ce n'est pas de l'enregistrement mais j'ai regardé sur les forum des réponses à mon problème et je me suis retrouvé avec une macro non optimisé,

je veut détailler mes macros pour simplifier.

Merci pour votre aide

Rechercher des sujets similaires à "optimisation calcul vba"