Importar TXT ancho fijo a Excel varios archivos
Escribo solicitando apoyo en cuanto a una macro que me pueda ayudar a importar Varios archivos TXT a un Excel y este se tiene que delimitar por una distancia fija que se selecciona con las flechas en el recuadro las distancias del archivo son 35, 105, 129, 150, 170 y 200 que al generarlo crea 7 columnas, e esta importación luego tengo que replicarla unas 200 veces mas con históricos de años anteriores.
Estoy usando una macro creada por el amigo Dante Amor la cual es la siguiente :
Sub Macro2()
'Por Dante Amor
'Importar Archivo txt
'
Application.ScreenUpdating = False
Set l1 = ThisWorkbook
Set h1 = Sheets("Hoja7") 'nombre de la hoja donde se va a importar
ruta = "c:\trabajo\" 'carpeta
ruta = "C:\Users\grhcrl.FLORESTA\Desktop\FAOV\NOMINAS QUINCENALES EMPLEADOS\JUNIO\"
'
If Right(ruta, 1) <> "\" Then ruta = ruta & "\"
' If Dir(ruta & arch) = "" Then
' MsgBox "No existe el archivo"
' Exit Sub
' End If
arch = Dir(ruta & "*.txt") 'nombre del archivo
'
Do While arch <> ""
Workbooks.OpenText _
Filename:=ruta & arch, _
Origin:=xlWindows, StartRow:=1, DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(35, 1), Array(100, 1), Array(129, 1), _
Array(150, 1), Array(170, 1), Array(200, 1)), TrailingMinusNumbers:=True
Set l2 = ActiveWorkbook
Set h2 = l2.Sheets(1)
u1 = h1.Range("A" & Rows.Count).End(xlUp).Row + 1
u2 = h2.Range("A" & Rows.Count).End(xlUp).Row
h2.Rows("1:" & u2).Copy h1.Range("A" & u1)
l2.Close False
arch = Dir()
Loop
Application.ScreenUpdating = True
MsgBox "Arhivo importado"
End Subesta macro me extrae los txt de la forma que necesito, solo que agrupa todos los txt de la ruta en la misma hoja y necesito que cada txt se genere en una hoja diferente del libro cambiando el nombre al que posee el txt
1 Respuesta
Te anexo la macro actualizada para crear una hoja por cada archivo txt
Sub Macro2()
'Por Dante Amor
'Importar Archivo txt
'
Application.ScreenUpdating = False
Set l1 = ThisWorkbook
'ruta = "c:\trabajo\" 'carpeta
ruta = "C:\Users\grhcrl.FLORESTA\Desktop\FAOV\NOMINAS QUINCENALES EMPLEADOS\JUNIO\"
'
If Right(ruta, 1) <> "\" Then ruta = ruta & "\"
arch = Dir(ruta & "*.txt") 'nombre del archivo
'
On Error Resume Next
Do While arch <> ""
Workbooks.OpenText _
Filename:=ruta & arch, _
Origin:=xlWindows, StartRow:=1, DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(35, 1), Array(100, 1), Array(129, 1), _
Array(150, 1), Array(170, 1), Array(200, 1)), TrailingMinusNumbers:=True
Set l2 = ActiveWorkbook
Set h2 = l2.Sheets(1)
l1.Sheets.Add after:=l1.Sheets(l1.Sheets.Count)
Set h1 = l1.ActiveSheet
h1.Name = Left(arch, Len(arch) - 4)
u2 = h2.Range("A" & Rows.Count).End(xlUp).Row
h2.Rows("1:" & u2).Copy h1.Range("A1")
l2.Close False
arch = Dir()
Loop
Application.ScreenUpdating = True
MsgBox "Arhivo importado"
End Sub
'.[Sal u dos. Dante Amor. No olvides valorar la respuesta.
¡Gracias! AMIGO excelente tu aporte
Buenos días amigo Dante Amor, disculpa la molestia y lo seguido, ¿si en la parte del código de los Array una de esas columnas no quiero que se importe como debería ajustar el código?
Ejemplo en el código: FieldInfo:=Array(Array(0, 1), Array(35, 1), Array(100, 1), Array(129, 1), _ Array(150, 1), Array(170, 1), Array(200, 1)), TrailingMinusNumbers:=True 'por decir la tercera columna de no necesitarla y quiero que se extraiga hasta el Array 35 y y que los campos del 36 al 128 no se tomen en cuenta sino del 129 en adelante con las siguientes columnas como debería especificarlo y disculpa la insistencia es para adaptarlo a otros archivos
Prueba haciendo la carga y después elimina en excel las columnas que no necesitas.
Revisa otra forma de cargar un txt:
