Anónimo
Copiar formato buscado
Estoy haciendo búsquedas entre dos hojas de un libro (función BUSCARV). Las celdas en una hoja tienen un formato específico que no se copian a la segunda hoja (por ejemplo el color del sombreado) ¿Hay alguna manera de traer también el formato?
Muchas gracias de antemano
Muchas gracias de antemano
1 Respuesta
Respuesta de doctorkaos
1
Es posible, pero un poco complicado de todas maneras te anexo un código para que lo intentes hacer
Range("A1").Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = _
"=IF(ISERROR(VLOOKUP(RC[-1],C[5]:C[6],2,0)),0,VLOOKUP(RC[-1],C7:C8,2,0))"
ActiveCell.Offset(1, -1).Select
Loop
Range("B1").Select
If ActiveCell = 0 Then
ActiveCell.Offset(0, 1).Select
Else
Dim X
Dim Y
Range("F1") = 1
Range("G2").Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(0, -1).Select
ActiveCell.FormulaR1C1 = "=IF(RC[1]"""",R[-1]C+1,"""")"
ActiveCell.Offset(1, 1).Select
Loop
X = ActiveCell.Offset(-1, -1).Value
For Y = 1 To X
valor_bus = Range("b" & Y)
Select Case valor_bus
Case Is = Range("h" & Y)
Range("h" & Y).Select
Selection.Copy
Range("B" & Y).Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End Select
Next Y
End If
Nada más cambia lo que te haga falta.
Range("A1").Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = _
"=IF(ISERROR(VLOOKUP(RC[-1],C[5]:C[6],2,0)),0,VLOOKUP(RC[-1],C7:C8,2,0))"
ActiveCell.Offset(1, -1).Select
Loop
Range("B1").Select
If ActiveCell = 0 Then
ActiveCell.Offset(0, 1).Select
Else
Dim X
Dim Y
Range("F1") = 1
Range("G2").Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(0, -1).Select
ActiveCell.FormulaR1C1 = "=IF(RC[1]"""",R[-1]C+1,"""")"
ActiveCell.Offset(1, 1).Select
Loop
X = ActiveCell.Offset(-1, -1).Value
For Y = 1 To X
valor_bus = Range("b" & Y)
Select Case valor_bus
Case Is = Range("h" & Y)
Range("h" & Y).Select
Selection.Copy
Range("B" & Y).Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End Select
Next Y
End If
Nada más cambia lo que te haga falta.