Como hacer un MACRO para importar varios archivos TXT con cierta información y quede ordenado por fecha

H o la: Te anexo la macro.

Supongo que el encabezado es el mismo, también que el número de columnas es el mismo, es decir, veo que son 7 columnas. También supongo que la separación de los datos está por tabulador.

Cambia en la macro "resultado", por el nombre de la hoja donde quieres el resultado de la importación.

También cambia "C:\Trabajo\temporal\", por el nombre de la carpeta donde tienes los datos.

La macro:

Sub ImportarTxt()
'Por.Dante Amor
    Application.ScreenUpdating = False
    Set l1 = ThisWorkbook
    Set h1 = l1.Sheets("resultado")
    ruta = "C:\Trabajo\temporal\"
    arch = Dir(ruta & "*.txt")
    h1.Cells.Clear
    j = 2
    Do While arch <> ""
        Workbooks.OpenText Filename:=ruta & arch, _
            Origin:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, _
            TextQualifier:=xlNone, ConsecutiveDelimiter:=True, _
            Tab:=True, Semicolon:=False, Comma:=False, Space:=True, _
            Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1)), _
            TrailingMinusNumbers:=True
        Set l2 = ActiveWorkbook
        Set h2 = l2.Sheets(1)
        Set b = h2.Columns("A").Find("Press", lookat:=xlWhole)
        If Not b Is Nothing Then
            fec = Left(arch, Len(arch) - 4)
            h1.Cells(j, "A") = fec
            f = b.Row + 2
            k = 2
            Do While h2.Cells(f, "A") <> ""
                h2.Range(h2.Cells(f, "A"), h2.Cells(f, "G")).Copy h1.Cells(j, k)
                k = k + 7
                f = f + 1
            Loop
            j = j + 1
        End If
        l2.Close False
        arch = Dir()
    Loop
    Application.ScreenUpdating = True
    MsgBox "Importación de archivos terminada", vbInformation, "IMPORTAR ARCHIVOS TXT"
End Sub

'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias

Buenas tardes,

Cambien el nombre de la hoja y de la ruta como me lo sugirio para que corriera la macros pero algo paso que no corrió, dejo todo en blanco en la hoja, pero le dejo un ejemplo de los archivos a los que le quiere extraer y ordenar la información, gracias por su oportuna respuesta. 

https://1drv.ms/f/s!Arf_hb3tghihghHO4QSwoGXyas72

No puedo descargar archivos, envíame 3 archivos txt y un archivo de excel con la carga de esos 3 archivos txt.

Mi correo [email protected]

En el asunto del correo escribe tu nombre de usuario “Jesus Salazar” y el título de esta pregunta.

Te anexo la macro actualizada, lo que pasa es los datos empiezan en la columna B

Sub ImportarTxt()
'Por.Dante Amor
    Application.ScreenUpdating = False
    Set l1 = ThisWorkbook
    Set h1 = l1.Sheets("test")
    ruta = "C:\Trabajo\temporal\"
    arch = Dir(ruta & "*.txt")
    u = h1.Range("A" & Rows.Count).End(xlUp).Row + 2
    h1.Range(h1.Cells(3, "A"), h1.Cells(u, Columns.Count)).Clear
    j = 3
    Do While arch <> ""
        Workbooks.OpenText Filename:=ruta & arch, _
            Origin:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, _
            TextQualifier:=xlNone, ConsecutiveDelimiter:=True, _
            Tab:=True, Semicolon:=False, Comma:=False, Space:=True, _
            Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1)), _
            TrailingMinusNumbers:=True
        Set l2 = ActiveWorkbook
        Set h2 = l2.Sheets(1)
        Set b = h2.Columns("B").Find("Press", lookat:=xlWhole)
        If Not b Is Nothing Then
            fec = Left(arch, Len(arch) - 4)
            h1.Cells(j, "A") = fec
            f = b.Row + 2
            k = 2
            Do While h2.Cells(f, "B") <> ""
                h2.Range(h2.Cells(f, "B"), h2.Cells(f, "H")).Copy h1.Cells(j, k)
                k = k + 7
                f = f + 1
            Loop
            j = j + 1
        End If
        l2.Close False
        arch = Dir()
    Loop
    Application.ScreenUpdating = True
    MsgBox "Importación de archivos terminada", vbInformation, "IMPORTAR ARCHIVOS TXT"
End Sub

R ecuerda cambiar la valoración de la respuesta

¡Gracias! 

Eres un Maestro-Pro!!!!