Copier la couleur d'une cellule dans une autre sur une autre feuille

L

lolomal

XLDnaute Nouveau
Bonjour à tous,

je suis nouveau sur ce site.

J'aimerais savoir comment copier la couleur d'une cellule (qui change de couleur quand je clique dessus) dans une autre située sur une autre page.

En d'autre terme, dans mon exemple, il y a 3 feuilles concernant 3 personnes et j'aimerais que les couleurs des cases (pour chien canard et poule) apparaissent dans ma feuille de synthèse.


Je pense qu'il faut utiliser le VBA mais je n'y connais rien.

Quelqu'un pourrait'il me donner le code à utiliser.

Vous remerciant de votre aide.
 

Pièces jointes

  • Exemple.xls
    42 KB · Affichages: 266
  • Exemple.xls
    42 KB · Affichages: 258
  • Exemple.xls
    42 KB · Affichages: 263
Trier par date Trier par votes
mromain

mromain

XLDnaute Barbatruc
Re : Copier la couleur d'une cellule dans une autre sur une autre feuille

Bonjour lolomal,

Voici un solution par macro.
La macro se déclenche à l'activation de la feuille Synthèse, il faut copier le code sur cette feuille (clic droit sur l'onglet, puis visualiser le code).
Par contre, il faut faire attention à respecter scrupuleusement le nom des feuilles et des animaux (je pense notamment à des espaces superflus dans les noms de feuille en colonne A).
VB: 
Private Sub Worksheet_Activate()
Dim cellNomFeuille As Range, cellAnimal As Range
    
    'initialisation des cellules
     Set cellNomFeuille = ActiveSheet.Range("A5")
    Set cellAnimal = ActiveSheet.Range("B4")
    
    'Boucle sur tous les noms de feuille de la colonne A
     'Tant que cellNomFeuille contient du texte
     While cellNomFeuille.Text <> ""
        
        'Boucle sur tous les noms d'animaux de la ligne 4
         'Tant que cellAnimal contient du texte
         Set cellAnimal = ActiveSheet.Range("B4")
        While cellAnimal.Text <> ""
            
            'copier la couleur
             On Error Resume Next
             With ThisWorkbook.Sheets(cellNomFeuille.Text)
                 ActiveSheet.Cells(cellNomFeuille.Row, cellAnimal.Column).Interior.ColorIndex = _
                     .Range("A:A").Find(cellAnimal.Text, LookIn:=xlValues, lookat:=xlWhole).Offset(0, 1).Interior.ColorIndex
             End With
            On Error GoTo 0
            
            'décaler cellAnimal d'une cellule vers la droite
             Set cellAnimal = cellAnimal.Offset(0, 1)
        Wend
        
        'décaler cellNomFeuille d'une cellule vers le bas
         Set cellNomFeuille = cellNomFeuille.Offset(1, 0)
    Wend
End Sub

A+
 
Vote positif 0 Vote négatif
K

kjin

XLDnaute Barbatruc
Re : Copier la couleur d'une cellule dans une autre sur une autre feuille

Bonjour,
Au plus simple, dans le module de ThisWorkBook...
Code: 
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Select Case Sh.Name
Case "Louis", "Anne", "Paul"
    If Not Application.Intersect(Target, Range("B5:B7")) Is Nothing Then
        Select Case Target.Interior.ColorIndex
        Case xlNone
            Target.Interior.ColorIndex = 4
        Case 4
            Target.Interior.ColorIndex = 6
        Case 6
            Target.Interior.ColorIndex = 3
        Case 3
            Target.Interior.ColorIndex = xlNone
        End Select
        With Sheets("Synthèse")
            Set col = .Rows(4).Find(Target.Offset(, -1))
            Set lig = .Columns(1).Find(Sh.Name)
            If Not col Is Nothing And Not lig Is Nothing Then
                .Cells(lig.Row, col.Column).Interior.ColorIndex = Target.Interior.ColorIndex
            End If
        End With
    End If
End Select
End Sub
...et supprimer les autres modules

Edit : salut Romain

A+
kjin
 
Vote positif 0 Vote négatif
L

lolomal

XLDnaute Nouveau
Re : Copier la couleur d'une cellule dans une autre sur une autre feuille

bonjour, à vous 2 et merci pour vos réponses rapides.

mromain: lorsque je met le code, cela ne marche que pour "anne" et pas pour les autres. Je n'arrive à faire les modifications pour que cela marche pour tous.

kjin : là cela marche très bien, le seul problème est que dans mon véritable programme j'ai beaucoup d'autres modules.

Il me faudrait si possible, une macro à mettre dans la feuille de synthèse

Je vous remercie encore de votre aide et espère une nouvelle réponse de votre part.
 
Vote positif 0 Vote négatif
L

lolomal

XLDnaute Nouveau
Re : Copier la couleur d'une cellule dans une autre sur une autre feuille

C'est encore moi, ne pouvant vous mettre le document complet (pas de moi), je mets ce à quoi je voudrais que cela ressemble.

J'aimerais que les couleurs qui s'affiche dans implication, courir...... apparaissent dans la feuille de synthèse.

Le vrai document comporte énormément de macros et modules (auxquels je ne comprends rien).

A+
 

Pièces jointes

  • Exemple.xls
    43.5 KB · Affichages: 220
  • Exemple.xls
    43.5 KB · Affichages: 227
  • Exemple.xls
    43.5 KB · Affichages: 223
Vote positif 0 Vote négatif
JNP

JNP

XLDnaute Barbatruc
Re : Copier la couleur d'une cellule dans une autre sur une autre feuille

Bonjour le fil :),
C'est bien ce que fait la macro de Kjin :mad:...
Comment veux-tu la mettre dans Synthèse pour la faire réagir sur les autres feuilles :confused: ?
Personnellement j'utiliserais plutôt l'événement double-clic, plus facile à gérer sur des changements successifs :rolleyes:...
La macro de Kjin recalibrée sur ton dernier fichier
Code: 
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
Select Case Sh.Name
Case "Dupond", "Robert", "Durand"
    If Not Application.Intersect(Target, Range("C5:C8")) Is Nothing Then
        Select Case Target.Interior.ColorIndex
        Case xlNone
            Target.Interior.ColorIndex = 4
        Case 4
            Target.Interior.ColorIndex = 6
        Case 6
            Target.Interior.ColorIndex = 3
        Case 3
            Target.Interior.ColorIndex = xlNone
        End Select
        With Sheets("Synthèse")
            Set col = .Rows(3).Find(Target.Offset(, -2))
            Set lig = .Columns(1).Find(Sh.Name)
            If Not col Is Nothing And Not lig Is Nothing Then
                .Cells(lig.Row, col.Column).Interior.ColorIndex = Target.Interior.ColorIndex
            End If
        End With
    End If
    Cancel = True
End Select
End Sub
Bon lundi :cool:
 
Vote positif 0 Vote négatif
L

lolomal

XLDnaute Nouveau
Re : Copier la couleur d'une cellule dans une autre sur une autre feuille

Je te remercie de ton aide JNP.

Le problème est que ça ne marche pas.

Je dois bien coller ta macro dans ThisWorkBook
Lorsque je fais cela rien ne se passe ?

Bon lundi à toi aussi
 
Vote positif 0 Vote négatif
mromain

mromain

XLDnaute Barbatruc
Re : Copier la couleur d'une cellule dans une autre sur une autre feuille

Bonjour lolomal, kjin, JNP, le forum,


Sinon, voici la macro précédente adaptée au nouveau fichier (la structure de celui-ci ayant changé par rapport à ta première demande) :
VB: 
Private Sub Worksheet_Activate()
Dim cellNomFeuille As Range, cellAnimal As Range, numCol As Long, numLigne As Long
   
    'initialisation des cellules
     Set cellNomFeuille = ActiveSheet.Range("A8")
    Set cellAnimal = ActiveSheet.Range("C3")
   
    'Boucle sur tous les noms de feuille de la colonne A
     'Tant que cellNomFeuille contient du texte
     While cellNomFeuille.Text <> ""
       
        'Boucle sur tous les noms d'animaux de la ligne 3
         'Tant que cellAnimal contient du texte
         Set cellAnimal = ActiveSheet.Range("C3")
        While cellAnimal.Text <> ""
           
            'copier la couleur
             On Error Resume Next
             With ThisWorkbook.Sheets(cellNomFeuille.Text)
                 ActiveSheet.Cells(cellNomFeuille.Row, cellAnimal.Column).Interior.ColorIndex = _
                     .Range("A:A").Find(cellAnimal.Text, LookIn:=xlValues, lookat:=xlWhole).Offset(0, 2).Interior.ColorIndex
             End With
            On Error GoTo 0
           
            'décaler cellAnimal d'une cellule vers la droite
             Set cellAnimal = cellAnimal.Offset(0, 1)
        Wend
       
        'décaler cellNomFeuille d'une cellule vers le bas
         Set cellNomFeuille = cellNomFeuille.Offset(1, 0)
    Wend
End Sub


PS: Il faut encore copier le code sur la feuille Synthèse (clic droit sur l'onglet, puis visualiser le code).

A+
 
Vote positif 0 Vote négatif
JNP

JNP

XLDnaute Barbatruc
Re : Copier la couleur d'une cellule dans une autre sur une autre feuille

Re, salut mromain :),
lolomal à dit:
Je te remercie de ton aide JNP.

Le problème est que ça ne marche pas.

Je dois bien coller ta macro dans ThisWorkBook
Lorsque je fais cela rien ne se passe ?
Cliquez pour agrandir...
C'est maintenant un double-clic sur la case à modifier dans chacune des feuilles qui modifie la couleur :rolleyes:...
Bonne suite :cool:
 
Vote positif 0 Vote négatif
F

Fo_rum

XLDnaute Accro
Re : Copier la couleur d'une cellule dans une autre sur une autre feuille

Bonjour,

un autre exemple :dans ThisWorbook (explications dans fichier joint)
Code: 
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    Dim Coul, Est As Range, Trouve As Range
    If ActiveSheet.Name = "Synthèse" Or Target.Count > 1 Then Exit Sub
    If Intersect(Target, Range("C5:C8")) Is Nothing Then Exit Sub
    Coul = Target.Interior.ColorIndex
    Target.Interior.ColorIndex = IIf(Coul = xlNone, 4, IIf(Coul = 4, 6, IIf(Coul = 6, 3, xlNone)))
    With Sheets("Synthèse")
        Set Est = .Rows(3).Find(Target.Offset(, -2))
        If Not Est Is Nothing Then
            Set Trouve = .[A:A].Find(ActiveSheet.Name)
            If Not Est Is Nothing Then Target.Copy .Cells(Trouve.Row, Est.Column)
        End If
    End With
    Range("B2").Select
End Sub
 

Pièces jointes

  • Copie de Fond.xls
    37.5 KB · Affichages: 242
Vote positif 0 Vote négatif
L

lolomal

XLDnaute Nouveau
Re : Copier la couleur d'une cellule dans une autre sur une autre feuille

je vous remercie tous pour votre attention portée sur ma question.

JNP et Fo_rum: vos solutions marchent très bien, le problème est que dans mon vrai document j'ai énormément de macro et de modules et ne peux donc pas les supprimer. Donc quand je mets le code dans ThisWorbook mes autres macros ne fonctionnent pas bien.

mromain : ta solution marche également mais si j'applique ton code à un autre document, quels sont les paramètres à changer?

Encore merci Lolomal
 
Vote positif 0 Vote négatif
K

kjin

XLDnaute Barbatruc
Re : Copier la couleur d'une cellule dans une autre sur une autre feuille

Bonsoir,
lolomal à dit:
JNP et Fo_rum: vos solutions marchent très bien
Cliquez pour agrandir...
J'en conclue que j'ai écrit une connerie :(
lolomal à dit:
le problème est que dans mon vrai document j'ai énormément de macro et de modules et ne peux donc pas les supprimer. Donc quand je mets le code dans ThisWorbook mes autres macros ne fonctionnent pas bien.
Cliquez pour agrandir...
La c'est toi qui en dit une !
Il n'a jamais été question de supprimer un module (d'ailleurs je ne sais pas comment on fait) mais simplement de supprimer les lignes de code correspondantes dans chaque module de feuille conformément au fichier initialement fourni. Rien ne t'empêche de conserver les autres procédures si elles existent !
Si dans la procédure, énumérer les feuilles te pose pb, tu peux regrouper les feuilles et tester leur index, ou mettre une valeur significative dans une cellule et tester cette cellule....

Reviens si j'ai encore dit une connerie ou que tu n'as rien compris
A+
kjin
 
Vote positif 0 Vote négatif
L

lolomal

XLDnaute Nouveau
Re : Copier la couleur d'une cellule dans une autre sur une autre feuille

Excuse moi Kjin, ta solution marche très bien aussi dans le document que je vous ai fournit, mais je n'arrive pas à l'utiliser dans mon autre document (le vrai) que malheureusement je ne peux pas vous envoyer (il a été réalisé par un groupe de travail).

plusieurs petites questions :
1) Case "..." correspond bien au nom des pages?

2) Que veulent dire ces 2 phrases :
Set col = .Rows(3).Find(Target.Offset(, -2))
Set lig = .Columns(1).Find(Sh.Name)
3) Dernières questions : à quel moment dans ton code, tu indique l'endroit où tu veux que la couleur apparaissent dans la feuille de synthèse.

Merci beaucoup et encore pardon de t'avoir oublié
 
Vote positif 0 Vote négatif

Discussions similaires

E
  • Question
XL 2016 Rechercher une valeur d'un tableau dans un autre tableau
Réponses
3
Affichages
154
JHA
J
halecs93
  • Résolu(e)
XL 2016 Appliquer sur une sélection la couleur d'une autre cellule
Réponses
4
Affichages
126
halecs93
halecs93
F
  • Résolu(e)
Microsoft 365 Copier juste couleur cellule.
Réponses
7
Affichages
304
Francky79
F
P
  • Résolu(e)
XL 2019 Couleur recopiée automatiquement sur la couleur d'une autre cellule.
Réponses
5
Affichages
569
sylvanu
sylvanu
A
  • Question
XL 2019 Ajouter ou supprimer une ligne selon un mot trouvé dans une autre feuille
Réponses
1
Affichages
124
Oneida
Oneida
H
  • Question
Microsoft 365 Mise en forme conditionnelle sur autre tableau
Réponses
2
Affichages
197
hbb
H
P
  • Question
XL 2019 Copier des cellules d'une feuille sur une autre
Réponses
2
Affichages
210
phoceenjo
P
E
  • Résolu(e)
Microsoft 365 VBA Function Recherche d'une couleur et renvoi résultats
Réponses
5
Affichages
245
Englobe
E
H
  • Résolu(e)
Autres copier des colonnes de tableau dans un autre onglet
Réponses
8
Affichages
361
hervoul
H
C
  • Question
XL 2013 faire une formule sous Excel 2013 pour copier les mises en forme d'une autre cellule
Réponses
4
Affichages
215
cd92600
C

Membres actuellement en ligne

2 membres et 36 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 084
Messages
2 085 194
Membres
102 813
dernier inscrit
kaiyi