Colorer des cases suivant liste

bonjour,

J'ai besoin d'aide :

j'ai une liste B39 à B47 sur la feuille 1 et je veux colorier sur la feuille 2 les cases avec ces valeurs trouvées.

1 couleur différente pour chaque valeur de la liste.

merci d'avance.

Bonjour,

Il suffit de faire 8 mises en format conditionnelle en feuille 2

Si valeur cellule=1 --> jaune

Si valeur cellule=2 ---< Beu

….

je voulais le faire en VBA car ces feuilles sont souvent modifiées

Bonjour philippou-84, Xmenpl , le forum,

je voulais le faire en VBA

Un essai.....la macro se déclenche si tu modifies une cellule dans la feuille 1 de B39 à B47 où si tu modifies une valeur de la feuille 2

Cordialement,

Bonjour,

Merci BEAUCOUP pour ton aide !!

par contre j'ai 2 petits soucis :

• c'est si une des cases est vide en B39 à B47
• le traitement est long lorsque on rentre les nouvelles valeurs B39 à B47 , le mieux c'est de lancer la macro manuellement.

encore merci

Re,

Merci pour ton retour,

Nouvelle tentative, la macro s'active par bouton....

Cordialement,

bonjour,

encore merci, ça fonctionne bien sauf j'ai plusieurs mots dans chaque case du coup comment faire pour avoir la fonction "contient" ?

je n'arrive pas à modifier ce code pour que ça détecte le texte recherché dans une case où il y a plusieurs texte dans la même case,

une fonction du type "contient" :

Sub couleur_brassage()
 Dim dl As Integer, dc As Integer, i As Integer
 Dim rg As Range, c As Range
 Dim pr As Range, val As Range

 Set pr = Sheets("Chantier").Range("B39:B47")                        'plage de critères

  With Sheets("Brassage")
       'dl = .Range("A" & Rows.Count).End(xlUp).Row                'dernière ligne utilisée de la colonne A
       dl = .UsedRange.Rows.Count                                  'dernière ligne utilisée de la feuille 2
       'dc = .Cells(1, Cells.Columns.Count).End(xlToLeft).Column   'dernière colonne utilisée de la ligne 1
       dc = .UsedRange.Columns.Count                               'dernière colonne utilisée de la feuille 2
   Set rg = .Range(.Cells(1, 1), .Cells(dl, dc))                   'plage de recherche (de A1 à dernière ligne/dernière colonne)...à adapter
    For Each c In rg                                               'pour chaque cellule de la plage
      Set val = pr.Find(c.Value, LookIn:=xlValues, lookat:=xlWhole) 'recherche valeur cellule de feuil2 dans plage feuil1
       If Not val Is Nothing Then
        c.Interior.ColorIndex = val.Interior.ColorIndex            'si valeur trouvée, couleur de la cellule trouvée
       Else
        c.Interior.ColorIndex = xlNone                             'si pas trouvée, aucune couleur
       End If
     Next c
  End With
End Sub

j'ai essayé de modifier le lookat xlWhole en XlPart mais sans succès :

Set val = pr.Find(c.Value, LookIn:=xlValues, lookat:=xlPart)

en plus si j'ai des cases vides sur la plage de critère ça met des couleur un peu de partout

plage de critère :

Set pr = Sheets("Chantier").Range("B39:B47")

Bonjour philippou_84,

Un essai largement inspiré de la macro de frangy,

https://forum.excel-pratique.com/viewtopic.php?forum_uri=excel&t=40310&start=

Option Explicit
Sub Test()
Dim dl As Long, dc As Long, P As Long
Dim rg As Range
Dim Cel As Range, C As Range, coul As Range
Dim firstAddress As String

Application.ScreenUpdating = False

    With Sheets("Feuil2")
          dl = .UsedRange.Rows.Count
          dc = .UsedRange.Columns.Count
      Set rg = .Range(.Cells(1, 1), .Cells(dl, dc))
       For Each coul In rg
        coul.Interior.ColorIndex = xlNone
        coul.Font.Bold = False
       Next coul
    End With

    With Sheets("Feuil1")
     For Each Cel In .Range("B39:B47")
      If Cel <> "" Then
        Set C = rg.Find(Cel, , xlValues, xlPart)
      End If
       If Not C Is Nothing Then
        firstAddress = C.Address
         Do
          P = InStr(C, Cel)
           C.Characters(Start:=P, Length:=Len(Cel)).Font.Bold = True
          C.Interior.ColorIndex = Cel.Interior.ColorIndex
           Set C = rg.FindNext(C)
         Loop While Not C Is Nothing And C.Address <> firstAddress
       End If
     Next Cel
    End With
End Sub

Cordialement,

super top ! merci beaucoup xorsankukai !