Combiner 2 macro

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 !

Ce sujet a été automatiquement fermé après 30 jours. Aucune réponse n’est permise dorénavant.