XL 2016 Colorée une cellule identique dans une autre feuille

[robertduval]

Bonjour je souhaite pouvoir colorée les mêmes cellules colorées sur une autre feuille, Merci de votre aide

 

[Lolote83]

Bonjour RobertDuval,
Avec cette petite macro, cela devrait correspondre à tes attentes

Sub TEST()
    Application.ScreenUpdating = False
    With Sheets("Feuil2")
        .Range("D2:D30").Interior.Color = RGB(255, 255, 255)
    End With
    For Each xCell In Range("C2:C30")
        xEquiv = Application.Match(xCell.Value, Sheets("Feuil2").Range("D2:D30"), 0)
        If IsError(xEquiv) = False Then
            If xCell.Interior.Color = RGB(0, 176, 80) Then
                With Sheets("Feuil2")
                    .Range("D" & xEquiv + 1).Interior.Color = RGB(0, 176, 80)
                End With
            End If
        End If
    Next xCell
    Application.ScreenUpdating = True
    MsgBox "Mise à jour terminée", vbInformation, "MAJ"
End Sub

@+ Lolote83

 

[JHA]

Bonjour à tous,

Un essai par MFC et une colonne supplémentaire.

JHA

 

[job75]

Bonjour à tous,

Voyez cette macro évènementielle dans le code de Feuil2 :

Private Sub Worksheet_Activate()
Dim d As Object, c As Range, x$
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
With Feuil1 'CodeName de la feuille
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    For Each c In .Range("C1", .Range("C" & .Rows.Count).End(xlUp))
        x = CStr(c)
        If x <> "" Then d(x) = c.Interior.Color 'mémorise la couleur
    Next
End With
Application.ScreenUpdating = False
If FilterMode Then ShowAllData 'si la feuille est filtrée
[D:D].Interior.ColorIndex = xlNone 'RAZ
For Each c In Range("D1", Range("D" & Rows.Count).End(xlUp))
    x = CStr(c)
    If d.exists(x) Then c.Interior.Color = d(x)
Next
End Sub

Elle se déclenche quand on active la feuille.

A+

 

[job75]

J'ai testé avec 90 000 lignes en Feuil2, la macro s'exécute chez moi en 2,02 secondes.

 

[robertduval]

Bonjour

Merci [B]Lolote83[/B], JHA, job75, c'est ça maintenant, me reste plus qu'a prendre la plus adaptées a mon fichier,
merci encore

 

[robertduval]

Job75, je t'ai remis ton fichier en fait si tu peus modifier juste la macro pour me prendre les colonnes suivantes en plus Merci

 

[job75]

Bonjour robertduval, le forum,

Voyez ce fichier (2) et la macro complétée :

Set r = [D:D,J:J,P:P,V:V,AB:AB]
r.Interior.ColorIndex = xlNone 'RAZ
For Each r In Intersect(r, UsedRange.EntireRow)
    x = CStr(r)
    If d.exists(x) Then r.Interior.Color = d(x)
Next

A+

 

[robertduval]

Superbe Merciii