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
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 !