Macro copiar formato filas según el valor de una columna
Tengo un Excel parecido al de la imagen (más elaborado, pero me vale para el ejemplo).
Querría crear una macro en la que me copiase el formato de la fila 1 para aquellas filas cuyo valor de A está entre 1000 y 1999, el de la fila 2 para las filas entre 2000 y 2999 y el de la fila 3, entre 3000 y 3999.
He estado probando con algo así:
Pero me da que hay varias cosas mal, ya que no consigo sacarlo.
¿Alguna ayuda?
Pd: Sé que en este caso se podría hacer aplicando un formato condicional, pero lo necesitaría con una macro.
3 respuestas
Respuesta de Dante Amor
2
Te anexo la macro
Sub Copiar_Color()
'Por.Dante Amor
For i = 4 To Range("A" & Rows.Count).End(xlUp).Row
If Cells(i, "A") >= 1000 And Cells(i, "A") <= 1999 Then
Rows(i).Interior.Color = Range("B1").Interior.Color
ElseIf Cells(i, "A") >= 2000 And Cells(i, "A") <= 2999 Then
Rows(i).Interior.Color = Range("B2").Interior.Color
ElseIf Cells(i, "A") >= 3000 And Cells(i, "A") <= 3999 Then
Rows(i).Interior.Color = Range("B3").Interior.Color
End If
Next
End Subsal u dos
Respuesta
1
Asdf Laica... prueba poniendo un xlPasteValues antes de tu aplication. CutCopyMode... igual y te resuelva tu problema.
Saludos!, estomas en contacto.
Respuesta de James Bond
1
La macro que ocupas es parecida a esta
Sub formato()
Set datos = Range("a1").CurrentRegion
With datos
r = .Columns(2).Address: f = .Rows.Count
.Cells(1, 2) = 1
.Cells(1, 2).AutoFill Destination:=Range(r), Type:=xlFillSeries
Set datos = .CurrentRegion
.Sort key1:=Range(.Columns(1).Address), order1:=xlAscending
For i = 1 To f
numero = .Cells(i, 1)
If numero >= 1000 And numero <= 1999 Then
.Cells(i, 1).Interior.ColorIndex = Range("e1").Interior.ColorIndex
End If
If numero >= 2000 And numero <= 2999 Then
.Cells(i, 1).Interior.ColorIndex = Range("e2").Interior.ColorIndex
End If
If numero >= 3000 And numero <= 3999 Then
.Cells(i, 1).Interior.ColorIndex = Range("e3").Interior.ColorIndex
End If
Next i
.Sort key1:=Range(.Columns(2).Address), order1:=xlAscending
.Columns(2).Clear
End With
End Sub