Copie d'une couleur

[nemesiswrc]

Bonjour a tous

Dans ce tableau se trouve 6 feuilles. 1 de résultats ou doivent apparaitre les prix les moins chers (c'est fait) et 5 autres ou se trouvent les prix en questions.

Ce sont des fournisseurs (1, 2, 3, 4, 5). Et je souhaiterait que ceux ci soit représenté dans le tableau RESULT par leurs couleurs respectives.

Please help

 

[nemesiswrc]

Re : Copie d'une couleur

Bonjour

Je me permet de faire remonter le sujet.

 

[leop93]

Re : Copie d'une couleur

Bonjour Nemesiswrc

On m'a proposé ce code pour quelque chose d'a peu près semblable:

'======================================================================
'Changement de couleur en fonction de l'état sélectionné.
'======================================================================
Sub colormacro()
  Dim i&

  For i = 2 To [I65536].End(xlUp).Row '2 car les valeurs commencent à la deuxième ligne du classeur

            If Cells(i, 9) = "CAS 1" Then '9 car la valeur à vérifier pour la couleur se trouve en 9 (I en horizontale)
            Cells(i, 1).Resize(, 14).Interior.Color = RGB(255, 255, 255)

            ElseIf Cells(i, 9) = "CAS 2" Then
            Cells(i, 1).Resize(, 14).Interior.Color = RGB(238, 253, 49)

            ElseIf Cells(i, 9) = "CAS 3" Then
            Cells(i, 1).Resize(, 14).Interior.Color = RGB(163, 163, 163)

            ElseIf Cells(i, 9) = "CAS 4" Then
            Cells(i, 1).Resize(, 14).Interior.Color = RGB(218, 88, 186)

            ElseIf Cells(i, 9) = "CAS 5" Then
            Cells(i, 1).Resize(, 14).Interior.Color = RGB(253, 109, 23)

            ElseIf Cells(i, 9) = "CAS 6" Then
            Cells(i, 1).Resize(, 14).Interior.Color = RGB(255, 28, 28)

            ElseIf Cells(i, 9) = "CAS 7" Then
            Cells(i, 1).Resize(, 14).Interior.Color = RGB(6, 253, 37)
            End If

    Next

End Sub

Avec en début de code dans ThisWorkbook ce code là:

'======================================================================
'Execution à chaque modification du fichier.
'======================================================================
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
colormacro
End Sub

J'espère que tu pourras l'adapter sur ton classeur.

Bonne journée

Leop93