Macro: convertir información en txt separado por pipes a excel por columnas

.

Hola! Te muestro otra forma:

Sub Macro1()
Dim mPath$, iFile$, C As Range
Application.ScreenUpdating = False
Rem> Carpeta donde se buscan los txt:
mPath = ThisWorkbook.Path & "\"
iFile = Dir(mPath & "*.txt")
Rem> Crea una nueva hoja:
Workbooks.Add xlWBATWorksheet
Do Until iFile = ""
Rem> Celda a partir de donde se colocarán los datos:
Set C = Cells(Rows.Count, "a").End(xlUp).Offset(1)
With ActiveSheet.QueryTables.Add(Connection:="Text;" & _
    mPath & iFile, Destination:=C)
  .FieldNames = False: .AdjustColumnWidth = False: .SaveData = False
  .TextFileTabDelimiter = False: .TextFileOtherDelimiter = "|"
  .TextFileColumnDataTypes = Array(1, xlYMDFormat, 1)
  .Refresh False
Rem> El parámetro xlYMDFormat indica que el segundo campo de los tres
Rem> que se importan es una fecha en el formato: año, mes y día.
  Names(.Name).Delete: .WorkbookConnection.Delete
End With
  iFile = Dir
Loop
Application.ScreenUpdating = True
End Sub

La observación respecto del formato de la fecha debes adecuarla a tus necesidades: "1" para campos con contenido general y el parámetro de fecha adecuado.

Buenos días,

Creo que me entendiste mal, es decir quiero que excel lea todos los archivos txt que tengo una carpeta pero esos archivos txt tienen información separada por pipes entonces la macro en excel tiene que leer la información dentro de los archivos y luego acomodarla por columnas dependiendo a donde este el separador o pipes, mira me encontré esta macro que hace el procedimiento pero a cada archivo le asigna una hoja en excel yo quiero que toda la información quede en una sola hoja y que la información de cada archivo txt quede hacia abajo en la misma hoja me puedes ayudar a modificarla muchas gracias por tu ayuda:

Sub Prueba()
On Error Resume Next
mio = ActiveWorkbook.Name
ruta = ActiveWorkbook.Path
ChDir ruta & "C:\Users\_quinoa5\Desktop\Archivos"
archi = Dir("*.txt")
Do While archi <> ""
Workbooks.OpenText archi, origin:=xlWindows, startrow:=1, DataType:=xlDelimited, other:=True, otherchar:="|"
otro = ActiveWorkbook.Name
ActiveSheet.Copy before:=Workbooks(mio).Sheets(1)
Workbooks(otro).Close False
archi = Dir()
Loop
End Sub

H o l a:

Te anexo la macro

Sub ConvertirTxt()
'Por.Dante Amor
    Application.ScreenUpdating = False
    Set l1 = ThisWorkbook
    Set h1 = l1.Sheets("Hoja2")
    ruta = "C:\trabajo\"
    arch = Dir(ruta & "*.txt")
    '
    Do While arch <> ""
        Workbooks.OpenText Filename:=ruta & arch, _
            Origin:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, _
            Tab:=True, Semicolon:=False, Comma:=False, Space:=False, _
            Other:=True, OtherChar:="|", FieldInfo:=Array(Array(1, 1)), _
            TrailingMinusNumbers:=True
        Set l2 = ActiveWorkbook
        Set h2 = l2.Sheets(1)
        u = h1.Range("A" & Rows.Count).End(xlUp).Row + 1
        If u = 2 And h1.[A1] = "" Then u = 1
        h2.UsedRange.Copy h1.Cells(u, "A")
        arch = Dir()
        l2.Close False
    Loop
    Application.ScreenUpdating = True
    MsgBox "Archivos cargados", vbInformation, "CONVERTIR TXT"
End Sub

Cambia en la macro "C:\trabajo\", por la ruta en donde tienes los archivos txt.

Cambia en la macro "Hoja2" por el nombre de la hoja en donde quieres poner el contenido de los txt

Creo que me entendiste mal, es decir quiero que excel lea todos los archivos txt que tengo una carpeta pero esos archivos txt tienen información separada por pipes entonces la macro en excel tiene que leer la información dentro de los archivos y luego acomodarla por columnas dependiendo a donde este el separador o pipes, mira me encontré esta macro que hace el procedimiento pero a cada archivo le asigna una hoja en excel yo quiero que toda la información quede en una sola hoja y que la información de cada archivo txt quede hacia abajo en la misma hoja me puedes ayudar a modificarla muchas gracias por tu ayuda:

Sub Prueba()
On Error Resume Next
mio = ActiveWorkbook.Name
ruta = ActiveWorkbook.Path
ChDir ruta & "C:\Users\_quinoa5\Desktop\Archivos"
archi = Dir("*.txt")
Do While archi <> ""
Workbooks.OpenText archi, origin:=xlWindows, startrow:=1, DataType:=xlDelimited, other:=True, otherchar:="|"
otro = ActiveWorkbook.Name
ActiveSheet.Copy before:=Workbooks(mio).Sheets(1)
Workbooks(otro).Close False
archi = Dir()
Loop
End Sub

Te entendí bien.

Mi macro hace lo que pediste. Hice la prueba con varios archivos txt.

Lo que no sé es cómo tienes tu información en los txt.

A lo mejor en tus archivos no tienes datos en la primer columna, o no tienen datos continuos, es por eso que no se puede encontrar cuál es la última fila de datos.

Te anexo mi macro actualizada para buscar la última fila y la última columna de cada archivo txt:

Sub ConvertirTxt()
'Por.Dante Amor
    Application.ScreenUpdating = False
    Set l1 = ThisWorkbook
    Set h1 = l1.Sheets("Hoja2")
    ruta = "C:\trabajo\"
    arch = Dir(ruta & "*.txt")
    '
    Do While arch <> ""
        Workbooks.OpenText Filename:=ruta & arch, _
            Origin:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, _
            Tab:=True, Semicolon:=False, Comma:=False, Space:=False, _
            Other:=True, OtherChar:="|", FieldInfo:=Array(Array(1, 1)), _
            TrailingMinusNumbers:=True
        Set l2 = ActiveWorkbook
        Set h2 = l2.Sheets(1)
        u = h1.UsedRange.Rows(h1.UsedRange.Rows.Count).Row + 1
        If u = 2 And h1.[A1] = "" Then u = 1
        u2 = h2.UsedRange.Rows(h2.UsedRange.Rows.Count).Row
        c2 = h2.UsedRange.Columns(h2.UsedRange.Columns.Count).Column
        h2.Range(h2.Cells(1, 1), h2.Cells(u2, c2)).Copy h1.Cells(u, "A")
        arch = Dir()
        l2.Close False
    Loop
    Application.ScreenUpdating = True
    MsgBox "Archivos cargados", vbInformation, "CONVERTIR TXT"
End Sub

Prueba nuevamente con mi macro y me comentas, si tienes alguna duda, entonces envíame 2 archivos txt a mi correo y en un archivo de excel me pones la unión de esos 2 archivos.

Mi correo [email protected]

En el asunto del correo escribe tu nombre de usuario “Andres Quiñones De La Torre” y el título de esta pregunta.

Las 2 macros que te envié funcionan correctamente.

No sé si ya las probaste. Pero funcionan muy bien con los archivos de prueba que me enviaste.

Prueba las macros que te envié las 2 funcionan. Si no te funcionan, tienes que decirme lo que te pone como resultado.

Por otra parte revisando tu macro:

Esto es lo que hace tu macro:

Do While archi <> ""
Workbooks.OpenText archi, origin:=xlWindows, startrow:=1, DataType:=xlDelimited, other:=True, otherchar:="|"

Esto es lo que hace mi macro:

Do While arch <> ""
        Workbooks.OpenText Filename:=ruta & arch, _
            Origin:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, _
            Tab:=True, Semicolon:=False, Comma:=False, Space:=False, _
            Other:=True, OtherChar:="|", FieldInfo:=Array(Array(1, 1)), _
            TrailingMinusNumbers:=True

Si revisas bien, es la misma instrucción, abrir cada archivo con OpenText, y separados por OtherChar:="|"

Entonces si ambas macros ocupan la misma instrucción para cargar, no deberías tener problema para que se cargue la información.

Si no has probado la macro que te envié, entonces te invito a que la pruebes y me digas qué resultado te puso.

Sal u dos