Reemplace el color de relleno de celda basado en el color de relleno de celda existente en una columna: excel, vba, macros, color de fondo, celdas

He adjuntado una captura de pantalla para visualizar lo que estoy tratando de hacer.

Estoy intentando reemplazar los colores de relleno de las celdas en una columna "Ayer" según el color de relleno de la celda existente.

He visto ejemplos de reemplazo de colores basados ​​en un valor en una celda, pero creo que tengo un escenario diferente.

Respuestas

Tal vez esto pueda ayudarle:

Option Explicit

Public Sub main()
Dim cell As Range, foundCells As Range
Dim yesterdayColor As Long, todayColor As Long

yesterdayColor = Range("H3").Interior.Color
todayColor = Range("H4").Interior.Color

With Range("B5:B17") "<--| reference wanted range of which coloring any "yesterdayColor" colored cells with "todayColor" color
Set foundCells = .Offset(, .Columns.Count).Resize(1, 1) "<-- initialize a dummy "found" cell outside the relevant range and avoid "IF" checking in subsequent "Union()" method calls
For Each cell In .Cells "<--| loop through referenced range cells
If cell.Interior.Color = yesterdayColor Then Set foundCells = Union(foundCells, cell) "<--| gather yesterday colored cells together
Next cell
Set foundCells = Intersect(.Cells, foundCells) "<--| get rid of the dummy "found" cell
End With
If Not foundCells Is Nothing Then foundCells.Interior.Color = todayColor "<--| if any cell has been found then change their color
End Sub

Edición: Prueba esto.

Public Sub ChangeCellColors()
Dim rngTarget As Excel.Range: Set rngTarget = Range("H3")
Dim rngSource As Excel.Range: Set rngSource = Range("H4")
Dim rngCell As Excel.Range

For Each rngCell In Range("B4:B17")
With rngCell.Interior
If rngCell.Interior.Color = rngTarget.Interior.Color Then
.Pattern = rngSource.Interior.Pattern
.PatternColorIndex = rngSource.Interior.PatternColorIndex
.Color = rngSource.Interior.Color
.TintAndShade = rngSource.Interior.TintAndShade
.PatternTintAndShade = rngSource.Interior.PatternTintAndShade
End If
End With
Next rngCell

Set rngSource = Nothing
Set rngTarget = Nothing
Set rngCell = Nothing
End Sub