Couleur d'une cellule copiée

Bonjour,

J'ai conçu une macro qui permet de copier dans une feuille "FOOD" la valeur d'une cellule d'une colonne dans une autre feuille "SANDBOX" définie lorsque la même référence à été trouvée dans les 2 feuilles.

Sub inject_stat()
            Dim d As Object, n&, I&, wbf$
            Set d = CreateObject("Scripting.Dictionary")

        With ThisWorkbook.Worksheets("SANDBOX")
            n = .Cells(.Rows.Count, 1).End(xlUp).Row
            For I = 1 To n
                d(.Cells(I, 6).Value) = .Cells(I, 5)
            Next I
        End With

        With ThisWorkbook.Worksheets("FOOD")
                n = .Cells(.Rows.Count, 7).End(xlUp).Row
                Application.ScreenUpdating = False
                For I = 1 To n
                    If .Cells(I, 7).Value <> "" Then
                     If d.exists(.Cells(I, 7).Value) Then
                      If d(.Cells(I, 7).Value) <> 0 Then
                       .Cells(I, 5) = d(.Cells(I, 7).Value)
                Next I
            End With
        End Sub

La macro fonctionne mais j'aimerais que lorsque la valeur à été trouvée dans SANDBOX et recopiée dans TABAC la ligne ou la cellule recopiée soit mise en couleur dans SANDBOX ceci afin de déterminer les valeurs non recopiée.

Merci pour votre aide.

Loadlucas

Bonjour,

à tester,

Sub inject_stat()
Dim d As Object, n&, I&, wbf$
Set d = CreateObject("Scripting.Dictionary")

With ThisWorkbook.Worksheets("SANDBOX")
    n = .Cells(.Rows.Count, 1).End(xlUp).Row
    For I = 1 To n
        d(.Cells(I, 6).Value) = .Cells(I, 5)
    Next I
End With

With ThisWorkbook.Worksheets("FOOD")
    n = .Cells(.Rows.Count, 7).End(xlUp).Row
    Application.ScreenUpdating = False
    For I = 1 To n
        If .Cells(I, 7).Value <> "" Then
          If d.exists(.Cells(I, 7).Value) Then
            If d(.Cells(I, 7).Value) <> 0 Then
              .Cells(I, 5) = d(.Cells(I, 7).Value)
               Sheets("SANDBOX").Cells(I, 5).Font.Color = RGB(192, 32, 255)
            End If
          End If
        End If
    Next I
End With
End Sub

Bonjour i20100,

Oui c'est ce que j'avais essayé mais ça ne fonctionne pas.

le nombre de ligne et l'ordre des articles dans la SANDBOX n'est pas le même que dans FOOD

Merci,

Loadlucas

re,

Bonjour,

J'ai fait ceci qui semble fonctionner :

Sub inject_stat()
Dim d As Object, e As Object, n&, I&, wbf$
Set d = CreateObject("Scripting.Dictionary")
Set e = CreateObject("Scripting.Dictionary")

With ThisWorkbook.Worksheets("SANDBOX")
    n = .Cells(.Rows.Count, 1).End(xlUp).Row
    For I = 1 To n
        d(.Cells(I, 6).Value) = .Cells(I, 5)
    Next I
End With

With ThisWorkbook.Worksheets("FOOD")
    n = .Cells(.Rows.Count, 7).End(xlUp).Row
    Application.ScreenUpdating = False
    For I = 1 To n
        If .Cells(I, 7).Value <> "" Then
          If d.exists(.Cells(I, 7).Value) Then
            If d(.Cells(I, 7).Value) <> 0 Then
              .Cells(I, 5) = d(.Cells(I, 7).Value)
            End If
          End If
        End If
    Next I
End With

With ThisWorkbook.Worksheets("FOOD")
    n = .Cells(.Rows.Count, 7).End(xlUp).Row
    For I = 1 To n
    If .Cells(I, 5).Value <> "" Then
        e(.Cells(I, 7).Value) = .Cells(I, 5)
    End If
    Next I
End With

With ThisWorkbook.Worksheets("SANDBOX")
    n = .Cells(.Rows.Count, 1).End(xlUp).Row
    Application.ScreenUpdating = False
    For I = 1 To n
        If .Cells(I, 6).Value <> "" Then
          If e.exists(.Cells(I, 6).Value) Then
            If e(.Cells(I, 6).Value) <> 0 Then
              .Cells(I, 5).Font.Color = RGB(192, 32, 255)
            End If
          End If
        End If
    Next I
End With
End Sub

Je test en ce moment ...

Merci à vous,

Loadlucas

Fonctionne pour moi !

Rechercher des sujets similaires à "couleur copiee"