Help with import TXT files with transposed lines into columns

[MarcusOliveira]

Hey guys,

I need your help with this case (sorry for the bad english )
I have this TXT file with payment details for each person divided by a line containing the name and year of the record, a new line with CPF number, and columns for each type of record (there are 7 colums, with headers).
The delimitator of columns are not clear (sometimes it's a space, sometimes it's a tabulation) so, I need a code to bring that lines (name and CPF) to new columns before the month column (Mês), delete the old lines and split that 7 columns in order to compose a proper database (the number of records (persons) is variable). Could you help me with that?
Below two images with before/after of what I need

Thanks in advance!

 

[DanteAmor]

The following macro loads the file "a.txt" in sheet 1 of your book.
Change
ruta = "C:\trabajo\txt" 'folder path
arch = "a1.txt" 'txt filename
by the names of your data

Sub Import_TXT()
    'import TXT files with transposed lines into columns
    'varios 25ene2019
    '
    Dim ruta As String, arch As String, linetxt As String, largo As String, nombre As String, cpf As String
    Dim h1 As Worksheet
    Dim n As Long, j As Long, col As Long, k As Long
    Dim lineas As Variant
    '
    Application.ScreenUpdating = False
    Set h1 = Sheets(1)
    h1.Rows("2:" & Rows.Count).ClearContents
    '
    ruta = "C:\trabajo\txt\"            'folder path
    arch = "a1.txt"                     'txt filename
    '
    If Dir(ruta & arch) = "" Then Exit Sub
    n = 0
    j = 2
    '
    Open ruta & arch For Input As [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] 
    Do While Not EOF(1)
        Line Input [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] , linetxt
        linetxt = WorksheetFunction.Substitute(linetxt, vbTab, " ")
        If InStr(1, linetxt, "nomo:") > 1 Then
            n = 1
            largo = InStr(10, linetxt, "Ano:") - 10
            nombre = WorksheetFunction.Trim(Mid(linetxt, 10, largo))
        End If
        If n = 2 Then
            largo = InStr(5, linetxt, ":") - 13 - 5
            cpf = WorksheetFunction.Trim(Mid(linetxt, 5, largo))
        End If
        If n >= 6 And n <= 17 Then
            col = 3
            lineas = Split(linetxt, " ")
            For k = LBound(lineas) To UBound(lineas)
                If lineas(k) <> "" And lineas(k) <> " " Then
                    h1.Cells(j, "A").Value = nombre
                    h1.Cells(j, "B").Value = "'" & cpf
                    h1.Cells(j, col).Value = lineas(k)
                    col = col + 1
                End If
            Next
            j = j + 1
        End If
        If n > 0 Then n = n + 1
    Loop
    ' Close the file.
    Close [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1[/URL] 
    Application.ScreenUpdating = True
    MsgBox "End"
End Sub

 

[MarcusOliveira]

Man, you're a genius! many thanks.

One last question: I noticed that the headers from columns weren't imported. How can I solve that?

PS.: i'm going to include your profile on script credits for the file.

The following macro loads the file "a.txt" in sheet 1 of your book.
Change
ruta = "C:\trabajo\txt" 'folder path
arch = "a1.txt" 'txt filename
by the names of your data

Sub Import_TXT()
    'import TXT files with transposed lines into columns
    'varios 25ene2019
    '
    Dim ruta As String, arch As String, linetxt As String, largo As String, nombre As String, cpf As String
    Dim h1 As Worksheet
    Dim n As Long, j As Long, col As Long, k As Long
    Dim lineas As Variant
    '
    Application.ScreenUpdating = False
    Set h1 = Sheets(1)
    h1.Rows("2:" & Rows.Count).ClearContents
    '
    ruta = "C:\trabajo\txt\"            'folder path
    arch = "a1.txt"                     'txt filename
    '
    If Dir(ruta & arch) = "" Then Exit Sub
    n = 0
    j = 2
    '
    Open ruta & arch For Input As [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1"]#1[/URL] 
    Do While Not EOF(1)
        Line Input [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1"]#1[/URL] , linetxt
        linetxt = WorksheetFunction.Substitute(linetxt, vbTab, " ")
        If InStr(1, linetxt, "nomo:") > 1 Then
            n = 1
            largo = InStr(10, linetxt, "Ano:") - 10
            nombre = WorksheetFunction.Trim(Mid(linetxt, 10, largo))
        End If
        If n = 2 Then
            largo = InStr(5, linetxt, ":") - 13 - 5
            cpf = WorksheetFunction.Trim(Mid(linetxt, 5, largo))
        End If
        If n >= 6 And n <= 17 Then
            col = 3
            lineas = Split(linetxt, " ")
            For k = LBound(lineas) To UBound(lineas)
                If lineas(k) <> "" And lineas(k) <> " " Then
                    h1.Cells(j, "A").Value = nombre
                    h1.Cells(j, "B").Value = "'" & cpf
                    h1.Cells(j, col).Value = lineas(k)
                    col = col + 1
                End If
            Next
            j = j + 1
        End If
        If n > 0 Then n = n + 1
    Loop
    ' Close the file.
    Close [URL="https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1"]#1[/URL] 
    Application.ScreenUpdating = True
    MsgBox "End"
End Sub

 

[DanteAmor]

Man, you're a genius! many thanks.

One last question: I noticed that the headers from columns weren't imported. How can I solve that?

PS.: i'm going to include your profile on script credits for the file.

The macro does not put the headers, please put the headers manually in row 1.


Thanks for the feedback