Mise en forme conditionnelle

Bonjour,

je souhaite mettre en couleur des cellules contiguës (feuil2) en fonction de résultats (feuil1).

Voir fichier

Merci de votre aide

Bonjour,

Voici une proposition:

Option Explicit
Sub RecupFondCouleur()
    Dim f1 As Worksheet, f2 As Worksheet
    Dim DerLig_f1 As Long, DerLig_f2 As Long, Col As Long, Lig As Long
    Dim N° As String
    Dim x As Range

    Application.ScreenUpdating = False
    Set f1 = Sheets("Feuil1")
    Set f2 = Sheets("Feuil2")
    DerLig_f1 = f1.Range("A" & Rows.Count).End(xlUp).Row
    DerLig_f2 = f2.Range("C" & Rows.Count).End(xlUp).Row

    For Col = 3 To 5 Step 2 'Colonne 3 et 5 de la feuille 2
        For Lig = 6 To DerLig_f2 'de la 1ère à la dernière ligne de la feuille 2
            N° = f2.Cells(Lig, Col) 'N° à traiter
            With f1.Range("A1:A" & DerLig_f1)
                Set x = .Find(N°, lookat:=xlWhole)
                If Not x Is Nothing Then
                    Select Case N°
                        Case 1, 3, 7, 13, 22
                            f2.Cells(Lig, Col).Interior.Color = RGB(255, 255, 0) 'jaune
                        Case 4, 5, 9, 16, 18, 24
                            f2.Cells(Lig, Col).Interior.Color = RGB(255, 0, 0) 'rouge
                        Case 11, 14, 20, 21
                            f2.Cells(Lig, Col).Interior.Color = RGB(247, 150, 70) 'orange
                        Case 6, 8, 10, 15, 19, 23
                            f2.Cells(Lig, Col).Interior.Color = RGB(0, 176, 240) 'bleu
                    End Select
                End If
            End With
        Next Lig
    Next Col

    f2.Select
    Set x = Nothing
    Set f1 = Nothing
    Set f2 = Nothing
End Sub

Cdlt

Bonjour tout le monde. En voici une autre :

Option Explicit

Sub Macro1()
    Dim table() As Long, i As Long, j As Long, nL As Long
    Dim wS1 As Worksheet, wS2 As Worksheet
    Dim cell As Range, plage As Range

    Set wS1 = Sheets("Feuil1")
    Set wS2 = Sheets("Feuil2")
    Set plage = wS2.Range("C6:C17,E6:E17")
    nL = wS1.Cells(Rows.Count, "A").End(xlUp).Row
    ReDim table(nL)

    For i = 1 To nL
        table(i) = wS1.Cells(i, 1).DisplayFormat.Interior.Color
    Next i

    For Each cell In plage.Cells
        For j = 1 To nL
            If wS1.Cells(j, 1) = cell.Value Then
                cell.Interior.Color = table(j)
                Exit For
            End If
        Next j
    Next cell
    wS2.Activate
End Sub