Copiar el contenido de archivos txt incrementalmente sobre hoja de excel
Les comento, tengo varios archivos txt, y necesito llevar su contenido a un libro y hoja de excel en particular. El detalle es que el contenido de cada txt debe ocupar linea a linea en el excel, y a continuación, el siguiente txt se debe agregar a la fila a continuación del contenido del txt anterior. Es decir:
Txt_1 tiene 20 registros, los cuales no importando el ancho, se copian entre la celda A1 y la A20 del Excel.
Txt_2 tiene 15 registros, y deben quedar desde la celda A21 en adelante (hasta la celda 36), por ej. Y así sucesivamente.
2 respuestas
Respuesta de Luis Mondelo
1
Respuesta de Ronald Iván Gonzales Romero
Lo puedes hacer así...
Sub cargar_FRD()
'Selecciona una carpeta,
'abre cada archivo FRD y copia la info en una fila
ruta = ThisWorkbook.Path
Set l1 = ThisWorkbook
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Selecciona una carpeta"
.AllowMultiSelect = False
.InitialFileName = ruta
If .Show <> -1 Then Exit Sub
cp = .SelectedItems(1)
End With
Application.ScreenUpdating = False
ChDir cp & "\"
archi = Dir("*.frd")
Do While archi <> ""
Workbooks.OpenText Filename:=cp & "\" & archi, _
Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, _
Tab:=False, Semicolon:=False, _
Comma:=True, Space:=False, _
Other:=False, OtherChar:="=", _
FieldInfo:=Array(Array(1, 2), Array(2, 2)), _
TrailingMinusNumbers:=True
Set l2 = ActiveWorkbook
Set h2 = l2.ActiveSheet
Range(Range("A1"), Range("A1"). SpecialCells(xlLastCell)). Copy 'Copia todo el contenido del archivo de texto
'h2.Range("B3:B" & Range("B" & Rows. Count).End(xlUp). Row). _
' SpecialCells(xlCellTypeConstants, 23).Copy /Copia solo la segunda columna luego del separador
l1. Activate
Range("A" & Range("A" & Rows.Count).End(xlUp).Row + 1).PasteSpecial _
Paste:=xlPasteAll, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
'Transpose:=True al pegar cambia la opcion para que los datos importados se muestren en vertical
l2.Close False
cont = cont + 1
archi = Dir()
'MsgBox "llega hasta aca en el do " & cont /Mensaje de control, muestra si esta entrando al do
Loop
Application.ScreenUpdating = True
MsgBox "Se cargaron : " & cont & " archivos FRD", vbInformation, "CARGA DE FRD"
End Sub