Necesito una Macro para poner colores en celdas
La macro que quiero es una Macro que me analice todas las celdas de un rango, si algunas de estas celdas contiene el color especificado, quiero que me aplique el mismo color en unas celdas de la misma fila.
El rango de columnas a analizar es la columna I i en las que quiero los colores es en las columnas L:Q.
He hecho este código i no me funciona no se si es la Macro correcta.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim CurCell As Object
For Each CurCell In Range("I6:I53")
x = CurCell.Row
If CurCell.Interior.Color = RGB(223, 168, 168) Then Range("Lx:Qx").Interior.Color = RGB(223, 168, 168)
Next
End Sub
1 respuesta
Pusiste tu macro en el evento Worksheet_SelectionChange, significa que cada vez que selecciones una celda, cualquier celda, se ejecutará la macro. ¿Eso es lo que necesitas? ¿O necesitas que se ejecute la macro cuando presiones un botón?
Tu macro quedaría corregida de la siguiente forma:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Act.Por.Dante Amor
For Each c In Range("I6:I53")
If c.Interior.Color = RGB(223, 168, 168) Then
Range("L" & c.Row & ":Q" & c.Row).Interior.Color = RGB(223, 168, 168)
End If
Next
End SubSi quieres la macro en un botón, es decir, que cada vez que presiones un botón se ejecute:
Sub Colorear()
'Act.Por.Dante Amor
For Each c In Range("I6:I53")
If c.Interior.Color = RGB(223, 168, 168) Then
Range("L" & c.Row & ":Q" & c.Row).Interior.Color = RGB(223, 168, 168)
End If
Next
End SubRevisa en qué momento quieres que se actualicen los colores.
P.d. Faltó que me enviaras por correo el archivo de la pregunta anterior.
Gracias por tu repuesta pero no me funciona este código no se si es por el código de color o porque no se activa sola
Prueba lo siguiente, pon la siguiente macro en un módulo y ejecútala
Sub poncolor()
Range("I7").Interior.Color = RGB(223, 168, 168)
End SubAhora selecciona cualquier celda de la hoja, si pusiste esta macro en el evento worksheet_selectionChange, entonces se ejecutará en automático y te va a colorear las celdas de la L a la Q
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Act.Por.Dante Amor
For Each c In Range("I6:I53")
If c.Interior.Color = RGB(223, 168, 168) Then
Range("L" & c.Row & ":Q" & c.Row).Interior.Color = RGB(223, 168, 168)
End If
Next
End Sub
No me funciona he enviado un correo con mi hoja para el asunto de la otra macro te agradecería que me miraras esta Muchas gracias
Hola_
Te anexo la macro para poner la cuenta en W8
Sub contar()
'Por.Dante Amor
Set ha = Sheets("Auxiliar1")
Set b = ha.Range("D:D").Find([T8])
If Not b Is Nothing Then
For Each c In Range("L5:Q57")
If c.Interior.Color = RGB(230, 185, 184) And _
c.Value = ha.Cells(b.Row, "E") Then
n = n + 1
End If
Next
[W8] = n
End If
End Sub
