Mover hojas de excel a un mismo libro respetando el nombre de la hoja
Me atoré con esta macro, lo que hace es abrir en excel archivos .asc contenidos en determinada ubicación, texto a columnas por "|". Lo que no puedo hacer es que en lugar de abrir libros nuevos, mover las hojas (respetando el nombre de cada una) al libro que contiene la macro y cerrar los libros que abré por cada archivo .asc procesado. Obteniendo así un libro de excel con una hoja nombrada como cada uno de los archivos .asc que contiene la ubicación escogida.
Sub DataStage()
'Abre archivos asc en diferentes libros nombrandolos con e nombre del orginal
'copia y pega todos los asc en pestañas de un mmismo libro (meta)
'Por PatriciaGarcía
'
'Poner todos los aarchivos asc en una carpeta en C:\
'
mio = ActiveWorkbook.Name
Set navegador = CreateObject("shell.application")
carpeta = navegador.browseforfolder(0, "SELECCIONA CARPETA", 0, "c:\").items.Item.Path
ChDir carpeta & "\"
archi = Dir("*.asc")
Do While archi <> ""
Workbooks.OpenText archi, origin:=xlWindows, startrow:=1, DataType:=xlDelimited, ConsecutiveDelimiter:=True, Other:=True, OtherChar:="|"
otro = ActiveWorkbook.Name
archi = Dir()
Workbooks(mio).Activate
Loop
MsgBox "proceso terminado"
End Sub
1 respuesta
Te anexo la macro actualizada
Sub DataStage()
'Abre archivos asc en diferentes libros nombrandolos con e nombre del orginal
'copia y pega todos los asc en pestañas de un mmismo libro (meta)
'Por PatriciaGarcía
'
'Poner todos los aarchivos asc en una carpeta en C:\
'
Application.ScreenUpdating = False
Set l1 = ThisWorkbook
Set navegador = CreateObject("shell.application")
carpeta = navegador.browseforfolder(0, "SELECCIONA CARPETA", 0, "c:\").items.Item.Path
ChDir carpeta & "\"
archi = Dir("*.asc")
Do While archi <> ""
Workbooks.OpenText archi, origin:=xlWindows, startrow:=1, DataType:=xlDelimited, ConsecutiveDelimiter:=True, Other:=True, OtherChar:="|"
Set l2 = ActiveWorkbook
'
l2.Sheets(1).Copy after:=l1.Sheets(l1.Sheets.Count)
l2.Close False
archi = Dir()
Loop
Application.ScreenUpdating = True
MsgBox "proceso terminado"
End Sub.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
.
Avísame cualquier duda
.
