Macro borrar datos de hoja sin borrar formato

Tengo una macro con la que me ayudaron, trabaja muy bien la cual busca datos en un libro y los anota en una hoja llamada buscador, pero a esta hoja no puedo darle formato ya que se elimina al usarlo, es decir por ejemplo si le pongo un fondo a la hoja de buscador o un relleno a las celdas se elimina al ejecutar el macro. Habrá forma que conserve el formato y en lo posible oculte las reglas de excel para que se vea un poco mejor. Y parezca un poco mas un programa. Bueno ójala me puedan ayudar anexo el código.

Sub ejemplo()

'por On Error GoTo salida

fila = 2 Application.DisplayAlerts = False

For Each hoja In ActiveWorkbook.Sheets

If hoja.Name = "buscador" Then hoja.Delete

Next ActiveWorkbook.Sheets.Add Before:=Worksheets("monografías bob")

ActiveSheet.Name = "buscador"

dato = InputBox("qué dato buscamos????")

If dato = "" Then Exit Sub

dato = UCase(dato)

For x = 1 To Sheets.Count Sheets(x).Select For Each celda In ActiveSheet.UsedRange

If UCase(celda) Like "*" & dato & "*" Then

Sheets("buscador").Cells(fila, 1).Value = Sheets(x).Name

Sheets("buscador").Cells(fila, 2).Value = celda.Address(False, False)

Sheets("buscador").Cells(fila, 3).Value = celda.Value

Sheets("buscador").Cells(fila, 4).Value = celda.Offset(0, 1).Value

fila = fila + 1 End If Next Next Sheets("buscador").Select MsgBox "los encuentros están anotados en la hoja buscador" Sheets("buscador").Select Range("a1").Value = "HOJA" Range("b1").Value = "DIRECCIÓN" Range("c1").Value = "VALOR DE LA CELDA" Range("d1").Value = "VALOR DE LA CELDA CONTIGUA" ActiveSheet.Columns("a:d").EntireColumn.AutoFit Columns("D:D").Select With Selection .HorizontalAlignment = xlLeft End With Range("a1").Select Exit Sub salida: MsgBox "ha ocurrido algún error, vuelva a ejecutar la búsqueda" End Sub

1 Respuesta

Respuesta
1

En la página se han apelotonado las líneas de código y es incomprensible. Mejor mándame el libro y así podemos probar con el mismo. Mandalo con la hoja Buscador con el formato que quieras ponerle y modificaremos la macro para que no altere el formato.

Mándame el libro a

[email protected]

Pon como asunto el título de la pregunta y como nombre del libro al go alusivo como

SinBorrarFormato.XLSM ( o la terminación que tenga)

Creo que ya lao tengo, La antigua macro se basaba en borrar la hoja Buscador y volver a crearla. Esta se basa en borrar solo los contenidos de la segunda fila para abajo. Por eso sobran algunas instrucciones de intercepción de errores y de restauración de la primera fila.

Por lo demás es una estupenda macro la de Luis Mondelo y muy bonita la estética de tu hoja.

Y así ha quedado. La parte de restaurar la primera fila la he puesto en una macro aparte por si la necesitaras, aunque lo normal es que no.

Sub ejemplo()
'por luismondelo y ValeroASM
Dim Ufil, Ucol, Fila As Integer
'Cambia el sistema y no son necesarias algunas líneas de intercepción de errores
For Each hoja In ActiveWorkbook.Sheets
    If LCase(hoja.Name) = "buscador" Then
       'En vez de eliminar la hoja borramos el contenido
       Ufil = hoja.Range("A" & Cells.Rows.Count).End(xlUp).Row
       Ucol = hoja.Cells(1, Cells.Columns.Count).End(xlToLeft).Column
       If Ufil < 2 Then Ufil = 2
       hoja.Range(Cells(2, 1), Cells(Ufil, Ucol)).ClearContents
    End If
Next
dato = InputBox("INGRESA LA BUSQUEDA??")
If dato = "" Then Exit Sub
dato = UCase(dato)
Fila = 2
'Lo siguiente es para que no se vean parpadeos
Application.ScreenUpdating = False
For x = 1 To Sheets.Count
   Sheets(x).Select
   For Each celda In ActiveSheet.UsedRange
      If UCase(celda) Like "*" & dato & "*" Then
         Sheets("buscador").Cells(Fila, 1).Value = Sheets(x).Name
         Sheets("buscador").Cells(Fila, 2).Value = celda.Address(False, False)
         Sheets("buscador").Cells(Fila, 3).Value = celda.Value
         Sheets("buscador").Cells(Fila, 4).Value = celda.Offset(0, 1).Value
         Sheets("buscador").Cells(Fila, 5).Value = celda.Offset(0, 2).Value
         Sheets("buscador").Cells(Fila, 6).Value = celda.Offset(0, 3).Value
         Sheets("buscador").Cells(Fila, 7).Value = celda.Offset(0, 4).Value
         Fila = Fila + 1
      End If
   Next
Next
Sheets("buscador").Select
ActiveSheet.Columns("a:g").EntireColumn.AutoFit
Range("A1").Select
Application.ScreenUpdating = True
MsgBox "los encuentros están anotados en la hoja buscador"
End Sub
Sub Restaurar_PrimeraFila()
'Aqui hemos recopilado lineas que no hacen falta pero vienen bien si se perdiera la fila primera.
Sheets("buscador").Select
Range("a1").Value = "HOJA"
Range("b1").Value = "DIRECCIÓN"
Range("c1").Value = "VALOR DE LA CELDA"
Range("d1").Value = "VALOR DE LA CELDA CONTIGUA"
Range("e1").Value = "VALOR ADQUISICION"
Range("f1").Value = "PRECIO PUBLICO"
Range("g1").Value = "ULTIMA ACTUALIZACION"
ActiveSheet.Columns("a:g").EntireColumn.AutoFit
Columns("D:F").HorizontalAlignment = xlLeft
Range("C1").Interior.Color = RGB(0, 255, 255)
Range("D1").Interior.Color = RGB(186, 85, 211)
Range("E1").Interior.Color = RGB(65, 105, 225)
Range("F1").Interior.Color = RGB(0, 255, 0)
Range("G1").Interior.Color = RGB(0, 255, 255)
End Sub

Ahora mismo preparare el fichero para mandártelo. Espero que te sirva. Si no entiendes algo preguntamelo. Y si ya está bien no olvides puntuar.

muchas gracias a luismondelo y ValeroASM, por su ayuda el código funciona muy bien. me servirá de mucho. y a todo el grupo de todoexpertos. que ofrece su ayuda incondicional. realmente son buenos en lo que hacen.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas