Combiner 2 macro


#1

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 !


#2

Bonjour,

Sans me pencher plus, n’ayant pas de classeur exemple
j’ajouterais à la fin de la macro MAJCouleurs

...
End If
Total
Next WS
End Sub

et dans la macro Total, je remplacerais
With Feuil2
par
With ActiveSheet


#3

AH ! J’ai cru que j’avais mis le fichier en pièce joint mais vraisemblablement non !
PE New Test 3.xlsm (2,8 Mo)

Alors ce que je veux faire c’est que le bouton “MAJ” sur la feuille “Tableau de bord” lance les deux macros MAJCouleurs et Total dans l’ensemble des onglets qui suivent (à l’exception de l’onglets “plan d’encadrement global”)

La macro MAJCouleurs fonctionnent parfaitement, et fait les modifications qui lui sont demandées. Le problème c’est la macro Total qui ne fonctionne que sur la feuille cité. Je n’arrive pas à faire fonctionner avec elle la condition

For Each WS in ActiveWorkbook.Worksheets
...
Next WS

Alors que cela fonctionne avec la macro MAJCouleurs…

en tout cas merci pour ton retour !!


#4

Re,

A tester
PE New Test 3.xlsm (2,5 Mo)


#5

Tu es un génie ! ça fonctionne parfaitement ! Et la solution aurais du me sauter aux yeux !

je peux abuser encore un peu de ton temps ? J’ai essayé de retoucher un peu, en tentant d’empêcher la macro Total d’agir sur certaines pages comme avec la condition suivante de la macro MAJCouleur

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

mais je ne trouve pas comment faire… J’avoue que la on rentre dans les limites de mes compétences et qu’il faudrait que je m’y remette !


#6

Bonjour,

Quelles pages ??

Il te suffit simplement dans la macro de déplacer le mot Total au-dessus du End If
image


#7

je crois que je suis fatigué ^.^’ vivement mes congés!

Un très très grand merci à toi !!!

Je clos le sujet !

cordialement,

Machiavel.


#8

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