Visual Basic - Crear un informe en Txt con datos repetitivos

Private Sub Genera_Documento()

    Dim FileNum As Long

    Dim iChoice As Integer

    FileNum = FreeFile()

    '¿Que pasa si necesitas ponerlo en otro directorio o necesitas otro nombre?

    'Lo sano aqui es que permitas seleccionarlo todo

    'ruta = ThisWorkbook.Path & "\"

    'En todo caso se lo dejaremos propuesto como el default

    fichero = Application.GetSaveAsFilename(FileFilter:= _

        "Archivos de Texto (*.txt), *.txt", _

        Title:="Guardar Archivo", _

        InitialFileName:=ThisWorkbook.Path)

    If fichero = False Then

        Exit Sub

    End If

    Open fichero For Output As #FileNum

    Sheets("DATOS").Select

    'No me gusta mucho el método pero es valido con esto ya sabes cuantos renglones procesaras.

    For i = 1 To Range("A" & Rows.Count).End(xlUp).Row

        'Algo que no explicas en tu pregunta, es como vas a concatenar las columnas solo pones el ejemplo

        'Es un poco dificil ayudar asi pero en esencia con esto puedes conseguir el fichero que has puesto

        dato = ""

        concat = ""

        For j = 1 To 3

            dato = dato & concat & Cells(i, j)

            concat = "|"

        Next

        For k = 4 To 6

            car = Cells(i, k)

            If IsNumeric(car) And car <> "" Then

                renglon = dato & "|" & car & "|" & car & "|" & vbCrLf

                Print #FileNum, renglon;

            End If

        Next

    Next

    Close #FileNum

    MsgBox "El TXT fue guardado en la ruta: " & ruta

End Sub

Private Sub Genera_Documento_2()

    Dim FileNum As Long

    Dim iChoice As Integer

    FileNum = FreeFile()

    '¿Que pasa si necesitas ponerlo en otro directorio o necesitas otro nombre?

    'Lo sano aqui es que permitas seleccionarlo todo

    'ruta = ThisWorkbook.Path & "\"

    'En todo caso se lo dejaremos propuesto como el default

    fichero = Application.GetSaveAsFilename(FileFilter:= _

        "Archivos de Texto (*.txt), *.txt", _

        Title:="Guardar Archivo", _

        InitialFileName:=ThisWorkbook.Path)

    If fichero = False Then

        Exit Sub

    End If

    Open fichero For Output As #FileNum

    Sheets("RESULTADO").Select

    'No me gusta mucho el método pero es valido con esto ya sabes cuantos renglones procesaras.

    For i = 2 To Range("A" & Rows.Count).End(xlUp).Row

        'Algo que no explicas en tu pregunta, es como vas a concatenar las columnas solo pones el ejemplo

        'Es un poco dificil ayudar asi pero en esencia con esto puedes conseguir el fichero que has puesto

        dato = ""

        concat = ""

        For j = 1 To 5

            dato = dato & concat & Cells(i, j)

            concat = "|"

        Next

        renglon = dato & "|" & vbCrLf

        Print #FileNum, renglon;

    Next

    Close #FileNum

    MsgBox "El TXT fue guardado en la ruta: " & ruta

End Sub