Hoja de varios excel exportada a txt
Buenas noches, cordial saludo.
He estado mirando sus publicaciones sobre este tema, pero mi conocimiento sobre programación en visual es muy básico y se me ha dificultado mucho adaptar la siguiente macro para que haga lo mismo para 7000 archivos de excel, y que el nombre del txt sea el valor de una determinada celda de la misma hoja que estoy copiando.
Agradecería alguna colaboración
Feliz noche
Sub crear_txt()
milibro = ActiveWorkbook.Name
Workbooks.Add
otro = ActiveWorkbook.Name
Workbooks(milibro).Activate
Sheets("hoja2").Copy before:=Workbooks(otro).Sheets(1)
ActiveWorkbook.SaveAs "documento", FileFormat:=xlText
activeworkbook.close false
End Sub
1 Respuesta
Hola, tengo 7000 hojas de excel, necesito copiar la hoja DATOS de cada uno de los archivos (son 7000 archivos con información diferente).
Necesito copiar la hoja DATOS en un txt, y que el txt lleve el nombre del archivo de excel que es el mismo que está en una de las celdas, por decir algo, el nombre que debe llevar el txt está en la celda B10 de la hoja DATOS
Muchas gracias por tu atención
¿Todos los archivos estan en la misma carpeta?
Si todos los archivos están en la misma carpeta. :/
Pon la siguiente macro en un tu archivo, guarda tu archivo en una carpeta diferente a donde se encuentran los 7000 archivos.
Cuando ejecutes la macro te va a solicitar que selecciones la carpeta de los 7000 archivos.
La macro abre todos los archivos xls*, selecciona la hoja datos y la guarda como txt.
En la parte inferior izquierda de excel te desplegará un mensaje de cuántos archivos ha procesado del total de archivos.
Sub abreyatxt()
'Por.DAM
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
ini = "C:\"
Set navegador = CreateObject("shell.application")
carpeta = navegador.browseforfolder(0, "SELECCIONE UNA CARPETA", 0, ini).items.Item.Path
If carpeta = "" Then Exit Sub
carpeta = carpeta & "\"
ChDir carpeta
archi = Dir("*.xls*")
Do While archi <> ""
cont = cont + 1
archi = Dir()
Loop
archi = Dir("*.xls*")
n = 1
Do While archi <> ""
Application.StatusBar = "Archivo procesado: " & n & " de " & cont
Workbooks.Open archi
Sheets("DATOS").Select
ActiveWorkbook.SaveAs Range("B10"), FileFormat:=xlText
ActiveWorkbook.Close False
archi = Dir()
n = n + 1
Loop
Application.StatusBar = False
End SubSaludos.Dante Amor
Recuerda valorar la respuesta
¡Gracias! Muchísimas gracias... La verdad es muy buena tu programación.
Mil gracias.
Ahora te hago otra preguntica, lo que pasa es que al ejecutar la macro, me sale una ventana que me dice que debo actualizar los vínculos. Podría eliminar este mensaje y que la macro corra sin tener que darle clic cada vez que aparezca el mensaje?.
Es posible guardar los txt en otra dirección?.
Muchas gracias, infinitas gracias :D
Para guardar los archivos en otra carpeta,
Cambia en la macro "trabajo" por la carpeta en donde quieres que se guarden
Sub abreyatxt()
'Por.DAM
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
ini = "C:\"
salida = "C:\trabajo\"
Set navegador = CreateObject("shell.application")
carpeta = navegador.browseforfolder(0, "SELECCIONE UNA CARPETA", 0, ini).items.Item.Path
If carpeta = "" Then Exit Sub
carpeta = carpeta & "\"
ChDir carpeta
archi = Dir("*.xls*")
Do While archi <> ""
cont = cont + 1
archi = Dir()
Loop
archi = Dir("*.xls*")
n = 1
Do While archi <> ""
Application.StatusBar = "Archivo procesado: " & n & " de " & cont
Workbooks.Open archi
Sheets("DATOS").Select
ActiveWorkbook.SaveAs salida & Range("B10"), FileFormat:=xlText
ActiveWorkbook.Close False
archi = Dir()
n = n + 1
Loop
Application.StatusBar = False
End SubY para que no te pregunte por los vínculos, sigue lo siguiente:
1. Selecciona en excel el botón de office.
2. Selecciona Opciones de excel
3. Selecciona Centro de confianza
4. Ahora presiona el botón que dice: Configuración del centro de confianza
5. Busca y selecciona la opción "Deshabilitar actualización automática de todos los vínculos del libro"
