Copiar el contenido de archivos txt incrementalmente sobre hoja de excel

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

¿Me mandas un par de txt para ver su contenido e intentar ayudarte?

[email protected]