Borrar el contenido de varias hojas

Juntando informacion aqui e alli, llegue a esta macro:

Sub borrartodo()
Dim Resp As Byte
Resp = MsgBox("Deseas borrar los datos?", _
    vbQuestion + vbYesNo, "ATENCIÓN")
If Resp = vbYes Then
    MsgBox "Se eligió continuar...", vbExclamation, "CONTINUAR"
COL1.Select
TravaDatos
With ActiveSheet
TravaDatos
If .ProtectContents = True Then
On Error Resume Next
.UsedRange = ““
On Error GoTo 0
COL1.Select
End If
End With
Else
    MsgBox "Se eligió cancelar...", vbCritical, "CANCELAR"
End If
End Sub

Funciona de maravilla, me borra todo el contenido de las celdas desbloqueadas.

Ahora tengo 7 hojas, necesito hacer que la macro borre el contenido de las celdas desbloqueadas de todas las hojas, no llegue a la solución hasta el momento, necesito vuestra ayuda.

1 Respuesta

Respuesta

No lo probé porque estoy en la calle y te escribo desde un cel pero prueba así

Sub borrartodo()
Dim Resp As Byte
Resp = MsgBox("Deseas borrar los datos?", _
    vbQuestion + vbYesNo, "ATENCIÓN")
If Resp = vbYes Then
    MsgBox "Se eligió continuar...", vbExclamation, "CONTINUAR"
COL1.Select
TravaDatos
NHojas=sheets.count
For i= 1 to  NHojas
With Hoja & i
TravaDatos
If .ProtectContents = True Then
On Error Resume Next
.UsedRange = ““
On Error GoTo 0
COL1.Select
End If
End With
Next i
Else
    MsgBox "Se eligió cancelar...", vbCritical, "CANCELAR"
End If
End Sub

Prueba si te funciona 

O prueba así que sea más seguro que te funcione por si tienes asignado el ActiveSheet en alguna otra parte

Sub borrartodo()
Dim Resp As Byte
Resp = MsgBox("Deseas borrar los datos?", _
    vbQuestion + vbYesNo, "ATENCIÓN")
If Resp = vbYes Then
    MsgBox "Se eligió continuar...", vbExclamation, "CONTINUAR"
NHojas=sheets.count
For i= 1 to  NHojas
Hoja&i.select
COL1.Select
TravaDatos
With ActiveSheet 
TravaDatos
If .ProtectContents = True Then
On Error Resume Next
.UsedRange = ““
On Error GoTo 0
COL1.Select
End If
End With
Next i
Else
    MsgBox "Se eligió cancelar...", vbCritical, "CANCELAR"
End If
End Sub

Perdon compañero jeje la sigo enbarrando xD jaja cambia esta linea

Hoja&i.select

por esta linea

Sheets(i).Select

Haciendo este arreglo tendria que funcionarte al 100%

Esto hara que se seleccione la hoja desde la Hoja1 hasta la ultima hoja y luego se ejecute tu macro

- El "FOR" es para que se repita el bucle hasta que pase por todas las hojas

- "NHojas" es el numero de hojas que tienes, que se consigue con "Sheets.Count" (cuenta las hojas)

De esta forma el for sabe hasta que hoja debe ir, y usamos numero que va recorriendo el for para asignar la hoja desde la variable "i".

Te sigo tirando respuestas, no vas a saber por donde empezar xD jajaja

También podrías crear una variable para que capture en que hoja estas en este momento para que te regrese a la misma al terminar la macro...

Solo agrega esta línea antes del "NHojas"

comienzo = ActiveSheet.Name

y despues del "Next i" agrega esta

Sheets(comienzo).Select

y para evitar el pantallazo cuando cambia de hoja solo agrega al principio del a macro despues del "Sub borrartodo()" esto:

Application.ScreenUpdating = False

y al final de tu macro antes del "End Sub" esto:

Application.ScreenUpdating = True

Hola Sebas Torres, gracias por su respuesta.

He probado todos los ajustes, sigue borrando la información de la hoja activa, no afecta las otras.

Si tu macro quedo así

Sub BorrarTodo()
Dim Resp As Byte
Application.ScreenUpdating = False
Resp = MsgBox("Deseas borrar los datos?", _
    vbQuestion + vbYesNo, "ATENCIÓN")
If Resp = vbYes Then
    MsgBox "Se eligió continuar...", vbExclamation, "CONTINUAR"
    c = ActiveSheet.Name
    NHojas = Sheets.Count
    For i = 1 To NHojas
        Sheets(i).Select
        COL1.Select
        TravaDatos
    With ActiveSheet
        TravaDatos
        If .ProtectContents = True Then
            On Error Resume Next
            .UsedRange = ““
            On Error GoTo 0
            COL1.Select
        End If
    End With
    Next i
    Sheets(c).Select
Else
    MsgBox "Se eligió cancelar...", vbCritical, "CANCELAR"
End If
Application.ScreenUpdating = True
End Sub

te deberia funcionar sin problemas, checa las macros "TravaDatos" y "COL1"si tambien te refieres a ActiveSheet o a esa hoja que tenias...

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas