SELECCIONAR VARIOS ARCHIVOS Y BORRAR EL CONTENIDO DE UN RANGO EN TODAS LAS HOJAS

Hola a todos:

Hace unos días que tengo ganas de publicar un post, pero por temas de agenda y tiempos me ha sido imposible hacerlo antes.

En el post que voy a publicar hoy vamos a dar respuesta a la consulta de un lector que me pedía si era posible crear una macro que fuese capaz de seleccionar varios archivos, navegar por todas las hojas y eliminar la información contenido en un rango en todas las hojas de todos los libros.

Bien, esto lo haremos con una rutina, y de paso añadiremos una serie de ventanas de diálogo y un inputbox para detallar el rango que queremos seleccionar.

Imaginemos dos archivos con dos hojas cada uno y en cada hoja una serie de datos. Vamos a borrar en cada hoja el siguiente rango: «A1:C15».

Para realizar este trabajo utilizaremos este código que he programado:

Option Explicit
Sub Borrando_archivos()
    'Declaramos variables
    Dim narchivos   As Variant, ilibro As Object
    Dim j           As Long, nhojas As Long, i As Long, elige As Long
    Dim Rango       As String, Titulo As String, Mensaje As String
    Dim MiRango     As String
    'Desactivamos actualización de pantalla
    Application.ScreenUpdating = FALSE
    'Seleccionamos archivos Excel
    narchivos = Application.GetOpenFilename(FileFilter:="Excel (*.xls*),*.xls", _
    Title:="Seleccionar archivos a borrar", MultiSelect:=True)
    'Si no hay selección salimos de la rutina
    If IsArray(narchivos) = FALSE Then Exit Sub
    'Indicamos el mensaje a mostrar
    Mensaje = "Introduce el rango para borrar su contenido." + Chr(13) + Chr(13) + "No uses comillas para expresar el rango, puedes ver el ejemplo:"
    'Indicamos el título del inputbox
    Titulo = "ATENCIÓN"
    'Indicamos el contenido del cuadro de texto
    Rango = "A1:C20"
    'Pasamos todos los datos al inputbox
    MiRango = InputBox(Mensaje, Titulo, Rango)
    'Si el inputbox no tiene dato salimos del proceso
    If MiRango = "" Then Exit Sub
    'Mostramos ventana de advetencia para verificar si deseamos borrar el contenido del rango seleccionado
    elige = MsgBox("ADVERTENCIA: ¿Deseas borrar el contenido del rango seleccionado?", vbYesNo + vbExclamation, "Borrar rango")
    'si pulsamos si:
    If elige = vbYes Then
        'Iniciamos loop por cada archivo seleccionado
        For j = LBound(narchivos) To UBound(narchivos)
            'Abrimos libro
            Set ilibro = Workbooks.Open(Filename:=narchivos(j))
            'Contamos número de hojas
            nhojas = Sheets.Count
            'Recorremos cada hoja y borramos el contenido del rango
            For i = 1 To nhojas
                Sheets(i).Select
                Range(MiRango).Select
                Selection.Clear
            Next i
            'Cerramos el archivo y guardamos cambios
            ActiveWorkbook.Close TRUE
            'Seguimos con el próximo archivo
        Next j
        'si pulsamos no, salimos de la rutina
    Else: Exit Sub
    End If
End Sub

El resultado es el siguiente:

Y esto es todo, espero que os sea de utilidad 🙂

Descarga el archivo pulsando en:

¿Te ha resultado de interés?, puedes apoyar a Excel Signum con una pequeña donación.



¡¡Muchas gracias!!

Mediante la suscripción al blog, la realización comentarios o el uso del formulario de contacto estás dando tu consentimiento expreso al tratamiento de los datos personales proporcionados según lo dispuesto en la ley vigente (LOPD). Tienes más información al respecto en esta página del blog: Política de Privacidad y Cookies