Crear un archivo excel a partir de varios archivos txt

¿El contenido del archivo texto lo quieres en una sola columna? Poner los datos en la columna A; ¿Y en la columna B poner el número?

Disculpa por no responder de inmediato...

No, necesito poner tantas columnas en excel como tenga el fichero texto, y al final agregarle la columna con el numero que viene en el nombre del fichero.. 

Hola Dante,

Alguna idea?

Gracias,

Aleida

Cómo sé que el archivo txt tiene varias columnas. ¿Están separadas por espacio o por tabulador?

Podrías enviarme por correo un archivo txt. También me envías un archivo excel con el resultado esperado de ese archivo txt.

mi correo [email protected]

Necesito una ayuda para crear un archivo de excel que me una varios archivos texto

Cómo quieres unir los archivos, es decir, quieres que la macro abra una ventana de archivos y que tú selecciones un archivo, ¿o quieres que la macro lea todos los archivos que están en una carpeta?

Por cierto, los datos en tu archivo están separados por tabulador.

Que abra la ventana y poder escoger los archivos que se van a unir.

Hola Dante, Muy buen día,

¿

Recibió el ficheto txt y el archivo en excel?

Un saludo,

Aleida

Prueba la siguiente macro:

En el libro donde pongas la macro deberás tener una hoja con el nombre "To_import", en esta hoja se unirán los archivos.

Sub Macro1()
  Dim sh As Worksheet, wb As Workbook, arch As Variant
  Dim lr1 As Long, lr2 As Long, lr3 As Long
  Dim sDatos As Variant, sNombre As String
  '
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  '
  Set sh = Sheets("To_import")
  sh.Rows("2:" & Rows.Count).ClearContents
  With Application.FileDialog(msoFileDialogFilePicker)
      .Title = "Seleccione archivos txt"
      .Filters.Clear
      .Filters.Add "Todos los archivos", "*.txt"
      .AllowMultiSelect = True
      .InitialFileName = "C:\trabajo\folder1"
      If .Show Then
        For Each arch In .SelectedItems
          sDatos = Split(arch, "_")
          sNombre = Split(sDatos(UBound(sDatos)), ".")(0)
          '
          Workbooks.OpenText Filename:=arch, Origin:=xlWindows, _
            StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlNone, _
            ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
            Comma:=False, Space:=False, Other:=False, TrailingMinusNumbers:=True
          '
          Set wb = ActiveWorkbook
          lr1 = wb.Sheets(1).Range("A" & Rows.Count).End(3).Row
          lr2 = sh.Range("A" & Rows.Count).End(3).Row + 1
          wb.Sheets(1).Rows("2:" & lr1).Copy sh.Range("A" & lr2)
          lr3 = sh.Range("A" & Rows.Count).End(3).Row
          sh.Range("T" & lr2 & ":T" & lr3).Value = sNombre
          wb.Close False
        Next
      End If
  End With
End Sub

Hola,

Buenos días!

Maravilloso, Funciono perfecto pero no me puso el encabezamiento de las columnas. ¿Cómo poderlo incluir?

Muchas gracias por su tiempo!

Aleida

Hola Dante..,

Me acabo de dar cuenta que los ceros en la izquierda no los mantuvo al unirlos en excel.

Y necesito mantener los ceros a la izquierda.

Como hacer?

Gracias

Aleida

No me puso el encabezamiento de las columnas. ¿Cómo poderlo incluir?

Solamente pon los encabezados en la hoja "To_import" en la fila 1.

Y necesito mantener los ceros a la izquierda.

¿Exactamente en dónde no mantiene los ceros?

Puedes poner una imagen para ver en dónde faltan y cómo los quieres.

 Este es el fichero .txt que tiene los ceros a la izquierda y el excel no los tiene.

No puedo ver qué campos son los que quieres con ceros. Los datos están movidos con respecto a los títulos, pero supongo que son el campos ZIP y ZIP4. De izquierda a derecha son los campos 13 y 14 respectivamente.

En la siguiente macro los campos 13 y 14, tienen formato texto con el número 2 (para conservar los ceros) en esta línea:

Array(13, 2), Array(14, 2)

Si no son los campos 13 y 14 o si quieres otro campo, solamente cambia el 1 por 2. Por ejemplo si quieres en texto el campo 16, entonces cambia el 1 por 2 en esta parte:

Array(16, 1)

Para que sea texto lo cambias a:

Array(16, 2)

Así de simple.

Prueba nuevamente:

Sub Macro1()
  Dim sh As Worksheet, wb As Workbook, arch As Variant
  Dim lr1 As Long, lr2 As Long, lr3 As Long
  Dim sDatos As Variant, sNombre As String
  '
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  '
  Set sh = Sheets("To_import")
  sh.Rows("2:" & Rows.Count).ClearContents
  With Application.FileDialog(msoFileDialogFilePicker)
      .Title = "Seleccione archivos txt"
      .Filters.Clear
      .Filters.Add "Todos los archivos", "*.txt"
      .AllowMultiSelect = True
      .InitialFileName = "C:\trabajo\folder1"
      If .Show Then
        For Each arch In .SelectedItems
          sDatos = Split(arch, "_")
          sNombre = Split(sDatos(UBound(sDatos)), ".")(0)
          '
          Workbooks.OpenText Filename:=arch, Origin:=xlWindows, _
            StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlNone, _
            ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
            Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
            Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
            Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), _
            Array(12, 1), Array(13, 2), Array(14, 2), Array(15, 1), Array(16, 1), _
            Array(17, 1), Array(18, 1)), TrailingMinusNumbers:=True
          '
          Set wb = ActiveWorkbook
          lr1 = wb.Sheets(1).Range("A" & Rows.Count).End(3).Row
          lr2 = sh.Range("A" & Rows.Count).End(3).Row + 1
          wb.Sheets(1).Rows("2:" & lr1).Copy sh.Range("A" & lr2)
          lr3 = sh.Range("A" & Rows.Count).End(3).Row
          sh.Range("T" & lr2 & ":T" & lr3).Value = sNombre
          wb.Close False
        Next
      End If
  End With
End Sub

Ahora si funciono todo, era ese campo 13, 14 y le adicione el 16. perfecto, muchas gracias!!

Que tengas muy lindo fin de semana,

Gracias,

Aleida