Macro borrar datos de hoja sin borrar formato

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.