Borrar masivamente contenido de archivos Excel
Tengo alrededor de 6.000 archivos Excel, donde hemos cargado información en dos columnas, cada archivo tiene entre 5 y 100 registros.
Necesito borrar todo el contenido menos la fila 1, donde están los encabezados de las dos columnas, y además mantener el formato de decimales, pues algunos tienen dos y otros tienen tres.
El tema es que necesito los archivos con sus nombres, ya que volver a crearlos sería un trabajo enorme, pero también tomé el tiempo de una muestra y borrar los contenidos manualmente nos tomaría 14 horas!
2 Respuestas
Te puedo ayudar pero necesito mas información:
-¿Qué dos columnas son las que tienen los datos?
-¿En qué pestaña están los datos en cada archivo?
-¿En qué carpeta están guardados los 6000 archivos? Necesito el path completo de la carpeta.
Hola Luismondelo, muchas gracias por responder.
- Las columnas son en todos los casos la A y la B
- La fila 1 contiene los encabezados de esas dos columnas, que deberíamos mantener
- Supongo que por pestaña te referís a la hoja, todos están en la hoja 1 y no hay nada en las otras dos hojas que se generan por default
- Están guardados en unas 40 carpetas pero eso no es problema, porque si vos me indicás la ruta yo creo una carpeta de trabajo y los voy moviendo allí
- Por último, no se si este dato te sirve, pero fueron generados con una planilla de Linux, supongo que Open Office o Libre Office, pero fueron guardados como xls o sea versión anterior a Office 2007
Muchas gracias!
Te mando mi solución y sigue mis instrucciones:
-En primer lugar copia todos los archivos juntos a una única carpeta y en este caso crea una carpeta que cuelgue directamente de C y la llamas "JUNTOS"
-Después abre un documento nuevo de excel y pega esta macro en un módulo. Solo queda ejecutarla y listo!
Sub borrado()
ChDir "c:\juntos\"
archi = Dir("*.xl*")
Do While archi <> ""
Workbooks.Open archi
Sheets(1).Select
Range("a2:b" & Range("a65000").End(xlUp).Row).ClearContents
ActiveWorkbook.Close True
archi = Dir()
Loop
End Subrecuerda finalizar y puntuar.
Espectacular Luis, muchísimas gracias!
Para finalizar, es posible antes de guardar que el cursor quede en la celda A2?
Saludos
Claro, entonces la macro sería esta:
Sub borrado()
ChDir "c:\juntos\"
archi = Dir("*.xl*")
Do While archi <> ""
Workbooks.Open archi
Sheets(1).Select
Range("a2:b" & Range("a65000").End(xlUp).Row).ClearContents
range("a2").select
ActiveWorkbook.Close True
archi = Dir()
Loop
End Subrecuerda finalizar y puntuar amigo
También puedes utilizar este código con arreglos:
Primero: Coloca todos lo archivos en una carpeta de nombre C:\NEW LIBROS\
Const n1 = 60
Type arreglo
elemento1(1 To n1) As String
End Type
Sub borrado()
Dim ARCHIVOS As String, rcd1 As arreglo
libro_programa = ActiveWorkbook.Name
libros= 1
carpeta = "C:\NEW LIBROS\"
ARCHIVOS = Dir(carpeta)
If Len(ARCHIVOS) = 0 Then
MsgBox "NO TIENE NINGUN DOCUMENTO EN LA CARPETA ""NEW LIBROS"""
Exit Sub
End If
Do While Len(ARCHIVOS) > 0
rcd1.elemento1(libros) = ARCHIVOS
ARCHIVOS = Dir()
libros= libros + 1
Loop
libros = libros - 1
For inicio1 = 1 To libros
Workbooks.Open Filename:="D:\NEW LIBROS\" & rcd1.elemento1(inicio1) & ""
Range("A2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Delete Shift:=xlUp
Range("A2").Select
ActiveWorkbook.Save
ActiveWindow.Close
Next
MsgBox ("Libros Excel Limpios")
End Sub
Muy buena tu ayuda. Lo pude adaptar para resolver otro problema. Gracias - Joc Zuco