Macro para mantener el formato de una hoja a otra en excel
Esta pregunta es la continuación de otra pregunta antorior titulada "Macro para copiar el formato de una hoja a otra".
Me explico de nuevo.
El tema del color del texto y, ya puestos, el del fondo para cada empresa de la hoja PROGRAMACIÓN tiene una función. El color del texto me indica si la inspección a esta empresa está confirmada (NEGRO) o por confirmar (ROJO) (pudiendo ser estos cualquier color) y los colores del fondo me indican qué tipo de inspección es (por ejemplo: AMARILLO=Cerveza, ROSA=Vino, MARRÓN=refrescos, etc). Por lo tanto, lo que pretendía es que el formato de las celdas de PROGRAMACIÓN se me conservasen en FACTURACIÓN sean los que sean y que cuando cambien en la hoja PROGRAMACIÓN también lo hagan en la de FACTURACIÓN, eso si, conservandose los formatos de las columnas B y C (fechas) de la hoja FACTURACIÓN.
1 Respuesta
Te anexo la macro para mantener el formato de letra, de fondo de la celda y de las fechas.
Sub Resumen()
'Por.Dante Amor
Set h1 = Sheets("PROGRAMACIÓN")
Set h2 = Sheets("FACTURACIÓN")
uf = h1.Range("A" & Rows.Count).End(xlUp).Row
uc = h1.Cells(1, Columns.Count).End(xlToLeft).Column
u2 = h2.Range("A" & Rows.Count).End(xlUp).Row
If u2 = 1 Then u2 = 2
h2.Range("A2:E" & u2).ClearContents
h2.Range("A2:E" & u2).Font.ColorIndex = xlNone
'
For Each c In h1.Range(h1.Cells(2, "D"), h1.Cells(uf, uc)).SpecialCells(xlCellTypeConstants, 23)
Select Case Left(c.Value, 5)
Case "FESTI", "VACAC", "CURSO", "REUNI", "DIAS P"
Case Else
If c.MergeCells Then
valor = c.Value
If c.Value <> "" Then
i = c.MergeArea.Cells(1, 1).Row
f = c.MergeArea.Rows.Count + i - 1
n = c.MergeArea.Rows.Count
llenar h1, h2, c.Value, i, f, n, c.Column, c.Font.ColorIndex, c.Interior.ColorIndex
End If
Else
Llenar h1, h2, c.Value, c.Row, c.Row, 1, c.Column, c.Font.ColorIndex, c.Interior.ColorIndex
End If
End Select
Next
h2.Select
MsgBox "Facturación terminada", vbInformation
End Sub
Sub llenar(h1, h2, c, i, f, n, col, fcolor, icolor)
'Por.Dante Amor
u = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
h2.Cells(u, "A") = c
h2.Cells(u, "B") = h1.Cells(i, "A")
h2.Cells(u, "C") = h1.Cells(f, "A")
h2.Cells(u, "D") = n
h2.Cells(u, "E") = h1.Cells(1, col)
If fcolor = 3 Then
h2.Cells(u, "A").Font.ColorIndex = 3
h2.Cells(u, "A").Interior.ColorIndex = icolor
End If
End SubCambia la macro por esta nueva y me comentas.
Saludos. Dante Amor
Si es lo que necesitas.
No, a ver... ahora las empresas que no están confirmadas (en ROJO) se les copia también el color de fondo a la hoja FACTURACIÓN y, además, cuando cambias una empresa de día y inspector, en la hoja FACTURACIÓN, la celda que ocupaba esta empresa se queda con el formato de esta.
El tema está en que yo tengo una hoja de PROGRAMACIÓN con inspecciones a empresas por confirmar (texto en ROJO) y inspecciones confirmadas (texto en NEGRO). Las empresas por confirmar, una vez confirmadas, les cambio el color de texto a NEGRO. El formato de texto NEGRO o ROJO me interesa que se pase a la hoja FACTURACIÓN para poder hacer previsiones semanales o mensuales de facturación, por lo que las empresas en NEGRO suman y las que están en ROJO no.
Con la macro que me adjuntas, cuando cambio una empresa de ROJO a NEGRO, en la hoja de FACTURACIÓN sigue saliendo en ROJO.
El tema del color de fondo va a parte y no tiene ninguna relación con que la inspección esté confirmada o no.
Insisto en agradecerte tu ayuda Dante! Muchas gracias por adelantado
Estamos teniendo problemas con los formatos de las celdas, necesito limpiar la hoja para que los colores anteriores se desaparezcan y prevalezcan los nuevos colores.
La opción que se me ocurre, es que en una tercera hoja llamada "formato", se mantenga el formato de celdas, encabezados y columnas con fechas.
La macro copiará la hoja "formato" a la hoja "FACTURACIÓN", limpiando completamente la hoja "FACTURACIÓN".
Advertencia: el color rojo que utilices para el color de la letra deberá ser el color estándar número 3, ese color lo puedes verificar cuando cambias el color de la letra en, más colores: Personalizado, debe estar así:
Esta es la macro
Sub Resumen()
'Por.Dante Amor
Set h1 = Sheets("PROGRAMACIÓN")
Set h2 = Sheets("FACTURACIÓN")
Set h3 = Sheets("formato")
uf = h1.Range("A" & Rows.Count).End(xlUp).Row
uc = h1.Cells(1, Columns.Count).End(xlToLeft).Column
h3.Cells.Copy h2.[A1]
'
For Each c In h1.Range(h1.Cells(2, "D"), h1.Cells(uf, uc)).SpecialCells(xlCellTypeConstants, 23)
Select Case Left(c.Value, 5)
Case "FESTI", "VACAC", "CURSO", "REUNI", "DIAS P"
Case Else
If c.MergeCells Then
valor = c.Value
If c.Value <> "" Then
i = c.MergeArea.Cells(1, 1).Row
f = c.MergeArea.Rows.Count + i - 1
n = c.MergeArea.Rows.Count
llenar h1, h2, c.Value, i, f, n, c.Column, c.Font.ColorIndex, c.Interior.Color
End If
Else
llenar h1, h2, c.Value, c.Row, c.Row, 1, c.Column, c.Font.ColorIndex, c.Interior.Color
End If
End Select
Next
h2.Select
MsgBox "Facturación terminada", vbInformation
End Sub
Sub llenar(h1, h2, c, i, f, n, col, fcolor, icolor)
'Por.Dante Amor
u = h2.Range("A" & Rows.Count).End(xlUp).Row + 1
h2.Cells(u, "A") = c
h2.Cells(u, "B") = h1.Cells(i, "A")
h2.Cells(u, "C") = h1.Cells(f, "A")
h2.Cells(u, "D") = n
h2.Cells(u, "E") = h1.Cells(1, col)
If fcolor = 3 Then
h2.Cells(u, "A").Font.ColorIndex = 3
h2.Cells(u, "A").Interior.Color = icolor
End If
End SubAntes de ejecutar la macro deberás crear una hoja llamada "formato".
Te envié por correo el ejemplo de la hoja "formato"
Prueba y me comentas.
