Bonjour à tous !
Je n’arrive pas à faire un fonctionner un code et je n’ai malheureusement pas le temps de me pencher dessus…
J’en appel donc à votre immense gentillesse pour m’aider à faire fonctionner celui ci !
Mon problème est le suivant:
Le code ci dessous me permet, sur l’ensemble de mes onglets, d’appliquer la macro qui applique la formule selon la couleurs de ces dernières:
Sub MAJCouleurs()
Application.ScreenUpdating = False
Dim c As Range
For Each WS In ActiveWorkbook.Worksheets
If WS.Name <> "Liste" And WS.Name <> "Tableau de bord" And WS.Name <> "Plan d'Encadrement Global" And WS.Name <> "Extraction DR PACA" And WS.Name <> "Extraction ESV TER CA" And WS.Name <> "Extraction ESV TER PA" And WS.Name <> "Extraction EV TGV PACA" And WS.Name <> "Extraction ET PACA" And WS.Name <> "Extraction TC PACA" And WS.Name <> "Extraction Rhumba" And WS.Name <> "Extraction Globale" Then
'Formule remplissage des lignes blanches. Couleurs = 16777214
Dim LigneBlanche
LigneBlanche = "=IF(OR(RC11=""AGPRO"",RC11=""AGTEC"",RC11=""AGING"",RC11=""AGAPP""),0,RC[-2])"
'Remplissage colonne R
For Each c In WS.Range("R1:R250")
If c.Interior.Color = 16777214 Then c.Formula = LigneBlanche
Next c
'Remplissage colonne S
For Each c In WS.Range("S1:S250")
If c.Interior.Color = 16777214 Then c.Formula = LigneBlanche
Next c
End If
Next WS
End Sub
Puis j’ai ce code qui me permet sur un seul onglets d’appliquer les formules indiquées si le mot “Total” est présent en colonne B
Sub Total()
Dim LastLig As Long, Deb As Long, Fin As Long
Dim S As Double, R As Double
Dim Prem As String
Dim c As Range
With Feuil2
LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
Set c = .Range("B2:B" & LastLig).Find("Total", LookIn:=xlValues, lookat:=xlPart)
Deb = 2
If Not c Is Nothing Then
Prem = c.Address
Do
Fin = c.Row - 1
.Range("R" & Fin + 1).Formula = "=SUMIF(E" & Deb & ":E" & Fin & ",""<>"",R" & Deb & ":R" & Fin & ")"
.Range("S" & Fin + 1).Formula = "=SUM(S" & Deb & ":S" & Fin & ")"
Deb = Fin + 2
R = R + .Range("R" & Fin + 1)
S = S + .Range("S" & Fin + 1)
Set c = .Range("B2:B" & LastLig).FindNext(c)
Loop While Not c Is Nothing And c.Address <> Prem
End If
.Range("R" & LastLig).Resize(, 2) = Array(R, S)
End With
End Sub
Ce que je n’arrive pas à faire c’est de combiner les deux ! De faire en sorte que la deuxième macro s’exécute aussi sur l’ensembles des onglets avec le “For Each WS In ActiveWorkbook.Worksheets”
J’en appel donc à votre aide ! Et vous remercie d’avance pour l’aide qui me sera apportée !