Exportar 100 líneas a .txt

RandalHP · el 24 de marzo

Hola que tal,

Tengo el siguiente código que me ayuda a exportar una columna cada 100 filas y guardar lo en una carpeta en formato .txt pero cada vez que exporto al final de la línea 100 se agrega un espacio en blanco, me pueden ayudar a quitarlo y que solo queden las 100 líneas que necesito.

Adjunto código:

Sub ExportarTXT()

Dim mPath$, iniCell$, i&, LR&, Vec, j%, iniTime!, R%

iniCell = "$G$2"

iniTime = Timer
mPath = ThisWorkbook.Path & "\Txt\"

With CreateObject("Scripting.FileSystemObject")
On Error Resume Next: .GetFolder(mPath).Delete True: On Error GoTo 0
.GetFolder(ThisWorkbook.Path).subFolders.Add "Txt"
End With

LR = Cells(Rows.Count, Range(iniCell).Column).End(xlUp).Row

For i = Range(iniCell).Row To LR Step 100
Vec = Cells(i, Range(iniCell).Column).Resize(100)
R = 1 + R
Open mPath & Format(R, "0000") & ".txt" For Output As #1
For j = 1 To 100
If Vec(j, 1) = "" Then Exit For
Print #1, Vec(j, 1)
Next
Close
Next
MsgBox "Proceso terminado en: " & Format(Timer - iniTime, "0.00 seg")
End Sub

Abraham Valencia · el 24 de marzo

Adjunta al menos una parte de tus datos para poder probar y ver directamente cuál es el problema.

RandalHP · el 27 de marzo

En 24/3/2023 at 15:15 , Abraham Valencia dijo:

Adjunta al menos una parte de tus datos para poder probar y ver directamente cuál es el problema.

Hola amigo,

Te adjunto una hoja de trabajo. Ss.

Exportar_TXT.xlsm

Israel Cassales · el 27 de marzo

Mi propuesta.

Podrías modificar un poco el código como te lo presento a continuación donde además el Print con el punto y coma (;) después del valor de la última línea, evita que se escriba una línea adicional en el archivo de texto.

Algo así:

Sub ExportarTXT()

    Dim mPath As String, iniCell As String, i As Long, LR As Long, Vec, j As Long, iniTime As Double, R As Long

    iniCell = "$G$2"
    iniTime = Timer
    mPath = ThisWorkbook.Path & "\Txt\"

    With CreateObject("Scripting.FileSystemObject")
        On Error Resume Next: .GetFolder(mPath).Delete True: On Error GoTo 0
        .GetFolder(ThisWorkbook.Path).subFolders.Add "Txt"
    End With

    LR = Cells(Rows.Count, Range(iniCell).Column).End(xlUp).Row

    For i = Range(iniCell).Row To LR Step 100
        Vec = Cells(i, Range(iniCell).Column).Resize(100)
        R = 1 + R
        Open mPath & Format(R, "0000") & ".txt" For Output As #1
        For j = 1 To UBound(Vec)
            If Vec(j, 1) = "" Then Exit For
            If j = UBound(Vec) Then
                Print #1, Vec(j, 1);
            Else
                Print #1, Vec(j, 1)
            End If
        Next
        Close
    Next
    MsgBox "Proceso terminado en: " & Format(Timer - iniTime, "0.00 seg")

End Sub

Lo estuve probando y me ha funcionado bien, creo cumple con lo que estás buscando.

Saludines.