Necesito que un TXT se pase los datos a excel pero ya en un excel tipo y que cada dato se meta en una columna

Este es el TXT:

y quiero meterle de esta forma en excel: 

Muchas graciasUn cordial saludo.

1 Respuesta

Respuesta
2

H o l a:

En un correo nuevo, envíame tus archivos de ejemplo, los datos del archivo txt deben coincidir con los datos que envíes en el excel.

Mi correo [email protected]

En el asunto del correo escribe tu nombre de usuario “Joaquin Moreno Lapoulide” y el título de esta pregunta.

Buenas noches Dante,

Acabo de enviártelo, mil gracias

Un cordial saludo

Te anexo la macro

Sub CargarTxt()
'Por.Dante Amor
'
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Set l1 = ThisWorkbook
    Set h1 = l1.Sheets("frm titulos")
    Set h2 = l1.Sheets("frm detalle")
    '
    Call borrarhojas
    With Application.FileDialog(msoFileDialogFilePicker)
        .Title = "Seleccione archivo txt"
        .Filters.Clear
        .Filters.Add "Archivos txt", "*.txt"
        .AllowMultiSelect = False
        .InitialFileName = l1.Path & "\"
        If Not .Show Then Exit Sub
        archivo = .SelectedItems.Item(1)
    End With
    '
    Workbooks.OpenText Filename:=archivo, Origin:=xlWindows, _
        StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, _
        Comma:=False, Space:=False, Other:=True, OtherChar:=";", _
        FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 2), Array(4, 2), Array(5, 2), _
        Array(6, 2), Array(7, 2), Array(8, 2), Array(9, 1), Array(10, 1), Array(11, 1), _
        Array(12, 1), Array(13, 1), Array(14, 1)), TrailingMinusNumbers:=True
    '
    Set l2 = ActiveWorkbook
    Set h21 = l2.Sheets(1)
    j = 6
    n = 1
    filas_insert = False
    For i = 1 To h21.Range("A" & Rows.Count).End(xlUp).Row
        If InStr(1, h21.Cells(i, "B"), "-") > 0 Then
            'crea hoja, copia encabezado
            h1.Copy after:=l1.Sheets(l1.Sheets.Count)
            Set h3 = ActiveSheet
            h3.Name = "cir " & n
            n = n + 1
            h3.[A4] = h3.[A4] & h21.Cells(i, "B")
            h3.[J3] = h3.[J3] & h21.Cells(i, "A")
            j = 6
        Else
            If h21.Cells(i, "D") = "" Then
                If filas_insert Then
                    j = j + 2
                    filas_insert = False
                End If
                'copia detalle
                h2.Range("A1:N6").Copy h3.Cells(j, "A")
                h3.Cells(j, "A") = "D.N.I.: " & h21.Cells(i, "A") & _
                                   "     TITULAR: " & h21.Cells(i, "B")
                j = j + 3
            Else
                filas_insert = True
                h3.Rows(j & ":" & j).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                h21.Range("A" & i & ":N" & i).Copy
                h3.Range("A" & j).PasteSpecial xlValues
                j = j + 1
            End If
        End If
    Next
    l2.Close
    Sheets(1).Select
    Application.ScreenUpdating = True
    MsgBox "Fin"
End Sub
'
Sub borrarhojas()
'Por.Dante Amor
    Application.DisplayAlerts = False
    For h = Sheets.Count To 1 Step -1
        If Left(Sheets(h).Name, 3) = "cir" Then
            Sheets(h).Delete
        End If
    Next
End Sub

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

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas