Macro sur toutes les feuilles

Bonjour à tous;
je rencontre quelques petits problème dans mon code.
Pour faire simple j'ai plusieurs feuilles avec des tableaux les uns sous les autres avec des couleurs de remplissage. Toutes les feuilles sont identiques seules les caractères et couleurs dedans changent. Le but du code est de compter le nombre de cellules rouges , vertes et oranges dans chaque feuille tant que la cellule n'est pas vide.

j'ai réalisé une macro qui fonctionne sur la feuille active dans laquelle je l'emploi; mais dès lors que je l'utilise sur une autre feuille ça fait changer le résultat obtenus dans les autres feuilles.
C'est mon premier problème.

le second problème : la dernière feuille est la feuille de synthèse.
J'aimerai qu'avec une macro; Excel puisse me retourner dans des cases différentes les 3 résultats de chaque feuille (nbre cases rouges, nbre cases vertes , nbre cases oranges).

Je vous joins le code que j'ai réalisé et qui pour l'instant fonctionne s'il est appliqué à une seule feuille. Il y'a donc une fonction différente pour calculer chaque couleur et j'aimerai n'en faire qu'une seule qui renvoit les 3 valeurs dans 3 cellules différentes.

Function CodeCouleur(CelluleCouleur As Range) As Long
'Retourne le code couleur de la CelluleCouleur
Application.Volatile
CodeCouleur = CelluleCouleur.Interior.ColorIndex
End Function

Function compterNok(couleur As Range) As Long

Dim nok As Integer
nok = 0
i = couleur.Row
j = couleur.Column

While i < 49

While Cells(i, j) <> ""
        If CodeCouleur(Cells(i, j)) = 3 Then nok = nok + 1 Else nok = nok + 0
        j = j + 1
    Wend

i = i + 12
j = couleur.Column
Wend

compterNok = nok
'retoune le nombre de case dont la couleur de remplissage est rouge
End Function


Function compterok(couleur As Range) As Long

Dim i As Integer
Dim j As Integer
Dim ok As Integer
ok = 0
i = couleur.Row
j = couleur.Column

While i < 49

While Cells(i, j) <> ""
        If CodeCouleur(Cells(i, j)) = 14 Then ok = ok + 1 Else ok = ok + 0
        j = j + 1
    Wend

i = i + 12
j = couleur.Column
Wend

compterok = ok
'retoune le nombre de case dont la couleur de remplissage est vert
End Function


Function compterpb(couleur As Range) As Long

Dim pb As Integer
pb = 0
i = couleur.Row
j = couleur.Column

While i < 49

While Cells(i, j) <> ""
        If CodeCouleur(Cells(i, j)) = 46 Then pb = pb + 1 Else pb = pb + 0
        j = j + 1
    Wend

i = i + 12
j = couleur.Column
Wend

compterpb = pb
'retoune le nombre de case dont la couleur de remplissage est orange
End Function

merci pour toutes les réponses possibles