Copier la couleur de fond d'une cellule dans une colonne plus loin

[suisse69]

Bonjour,

Je ne sais comment gérer la couleur de fond dans les formules =xxxxxxxx

En fait j'ai 3 colonne. Sur chaque ligne, la colone peut être rouge, vert, ou jaune. (Chaque couleur dans une colonne différenciée (cela ne doit pas changer)

Ce que je souhaite faire c'est résumés les couleurs de ces 3 colonnes en 1 seule. (voir le fichier XL pour mieux comprendre) Il est fort probable qu'il faille passer par du VBA. Mais j'y connais rien en programation, sauf comment l'inserer et l'executer.

Le top ca serait que ca fonctionne pour XL d'office 2003 et 2010.

Merci bien à celles et ceux qui s'y colle

 

[Victor21]

Re : Copier la couleur de fond d'une cellule dans une colonne plus loin

Bonjour, suisse69

La première question, avant de penser à VBA est : Les couleurs des 3 colonnes sont-elles appliquées manuellement, ou répondent-elles à une logique ? Et si oui, laquelle ?

 

[Bebere]

Re : Copier la couleur de fond d'une cellule dans une colonne plus loin

bonjour Suisse

Sub Couleur()
Dim L As Long

For L = 11 To 19'lignes 11 à 19
If Cells(L, 5).Interior.ColorIndex <> -4142 Then Cells(L, 11).Interior.ColorIndex = Cells(L, 5).Interior.ColorIndex
If Cells(L, 6).Interior.ColorIndex <> -4142 Then Cells(L, 11).Interior.ColorIndex = Cells(L, 6).Interior.ColorIndex
If Cells(L, 7).Interior.ColorIndex <> -4142 Then Cells(L, 11).Interior.ColorIndex = Cells(L, 7).Interior.ColorIndex
Next L

End Sub

 

[job75]

Re : Copier la couleur de fond d'une cellule dans une colonne plus loin

Bonjour suisse69, Patrick, Bebere

Peut-être cette solution :

Sub TransfertCouleurs()
Dim cel As Range
For Each cel In Intersect([E:G], ActiveSheet.UsedRange)
  If cel.Interior.ColorIndex <> xlNone Then _
    Intersect(cel.EntireRow, [K:K]).Interior.Color = cel.Interior.Color
Next
End Sub

Fichier joint.

A+

 

[job75]

Re : Copier la couleur de fond d'une cellule dans une colonne plus loin

Re,

Ceci est mieux si ref n'existe pas :

Sub TransfertCouleurs()
Dim ref As Range
Set ref = Intersect([E:G], ActiveSheet.UsedRange)
If ref Is Nothing Then Exit Sub
For Each ref In ref
  If ref.Interior.ColorIndex <> xlNone Then _
    Intersect(ref.EntireRow, [K:K]).Interior.Color = ref.Interior.Color
Next
End Sub

Fichier (2).

Edit : et s'il y a beaucoup de cellules, mettre Application.ScreenUpdating = False avant la boucle pour accélérer.

A+

 

[suisse69]

Re : Copier la couleur de fond d'une cellule dans une colonne plus loin

Bonjour à tous,

Merci pour vos solutions. Je vais essyaer cela demain.

Alors pour répondre à une des questions du début, les couleurs de mes colonnes apparaissent selon des condtions.
(Mise en forme conditionnelle)

Au plaisir de vous compter si ca fonctionner tout bientot.

Merci.

 

[Victor21]

Re : Copier la couleur de fond d'une cellule dans une colonne plus loin

Re,

pour répondre à une des questions du début, les couleurs de mes colonnes apparaissent selon des condtions.
(Mise en forme conditionnelle)

Vous pouvez alors probablement utiliser les mêmes conditions.
Joignez un exemple avec les mefc pour test.

 

[suisse69]

Re : Copier la couleur de fond d'une cellule dans une colonne plus loin

Bonjour à tous,

Alors j'ai essayer vos codes. Ils fonctionnent bien si on mets la couleur à la main.
Mais si la couleur apparaît après une mise en forme conditionnelle, cela ne va plus.

J'ai mis un exemple très simplifier dans la feuille ci joint.
Que faut il changer a ces codes pour qu'il prenne en compte la couleur après mise en forme conditionnel ?

(L'idée de faire une seule colonne qui regroupe toutes les 3 conditions m'a déjà traverser l'esprit. Mais ce n'est pas vraiment ce que je souhaite faire si je peut l'éviter)

Merci.

 

[Victor21]

Re : Copier la couleur de fond d'une cellule dans une colonne plus loin

Bonjour.

(L'idée de faire une seule colonne qui regroupe toutes les 3 conditions m'a déjà traverser l'esprit. Mais ce n'est pas vraiment ce que je souhaite faire si je peut l'éviter)

C'est pourtant le plus simple ...

 

[Bebere]

Re : Copier la couleur de fond d'une cellule dans une colonne plus loin

bonjour

Sub CouleurSiFormatConditionnel()
'tiré d'un code de L Longre
Dim FC As FormatCondition, c As Byte, cel As Range
For c = 5 To 7
For Each cel In Range(Cells(11, c), Cells(20, c))
cel.Select
For Each FC In ActiveCell.FormatConditions
    If Evaluate(FC.Formula1) Then Exit For
Next FC
If Not FC Is Nothing Then
Cells(cel.Row, 11).Interior.ColorIndex = FC.Interior.ColorIndex
End If
  Next cel
  Next c
  
End Sub

 

[suisse69]

Re : Copier la couleur de fond d'une cellule dans une colonne plus loin

Bebere t'est un AS !
Merci c'est parfaitement ce que je voulais.
De plus j'ai compris le code et peut l'appliquer plusieurs fois sur ma page c'est juste génial.

Merci beaucoup à tous. Bon week end !!!

 

[suisse69]

Re : Copier la couleur de fond d'une cellule dans une colonne plus loin

Hum hum ;-PP

Encore une question.
En réalité j'ai pas tout raconter et me suis réjouit trop vite.
Dans mes conditions j'ai mis que si y a rien de rempli la ligne devient noir.
Ce qui veut dire que dès qu'il y a une couleur, en fait les cases à coté de celle qui devient rouge, vert ou jaune, sont certainement considérée comme blanche. Du coup, il arrive pas me faire le résumer de la couleur que je souhaite.
J'ai remis l'exemple en copie. Et il possible de lui dire tu prend tout sauf celle qui sont blanche ? (Vide)

Je suis navré de ne pas l'avoir mis dès le départ. Je pensai pas qu'une cellule apparement de couleur "vide" soit prisent en compte.

Merci de votre réponse.

 

[Victor21]

Re : Copier la couleur de fond d'une cellule dans une colonne plus loin

Re,

J'insiste...

 

[suisse69]

Re : Copier la couleur de fond d'une cellule dans une colonne plus loin

Hello


J'ai changer mes conditions de départs et j'ai fait une mise en forme conditionnel du tout. Ainsi c'est réglé

Merci à tous.
Bon week end.