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
Y en vez de borrar, ¿habría alguna forma de coger esos valores y ponerlos en un mismo archivo? Es decir, el valor del la hoja1 que queremos (A1), irá en la hoja agregada a la izquierda de donde ponga hoja1 (celda B1)
Hola Laura:
Si lo que quieres decir es si es posible agrupar todos los rangos indicados de todas las hojas en una única hoja, eso lo puedes hacer modificando la siguiente macro:
https://excelsignum.com/2017/03/28/agrupar-informacion-de-varios-libros-en-una-hoja-excel/
Y en la macro sustituir esto:
Set iRango = iLibro.Sheets(i).Range(Cells(FilaInicio, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, Cells(1, Columns.Count).End(xlToLeft).Column))
por esto:
Set iRango = iLibro.Sheets(i).Range(«A1:C5»)