Excel - Dividir un columna en varios archivos txt de 100 filas

Sub guardar()

    inicio = Time()

    veces = Int(Sheets("Hoja1").Range("A1").End(xlDown).Row / 100) + 1

    For i = 1 To veces

        Sheets("Hoja1").Select

        desde = (i - 1) * 100 + 1

        hasta = desde + 99

        Rows(desde & ":" & hasta).Select

        Selection.Copy

        Sheets("Hoja2").Select

        Range("A1").Select

        ActiveSheet.Paste

        Application.CutCopyMode = False

        f = Format(i, "0000") & ".txt"

        ActiveWorkbook.SaveAs Filename:="C:\aa\" & f, FileFormat:=xlTextMSDOS, CreateBackup:=False

    Next

    fin = Time()

    MsgBox fin & " - " & inicio

End Sub

Sub Macro340()

'------------------

'by Cacho Rodríguez

'------------------

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

iniCell = "$E$1"

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

    Write #1, Vec(j, 1)

  Next

  Close

Next

MsgBox "Proceso terminado en: " & Format(Timer - iniTime, "0.00 seg")

End Sub

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

 Dim SW As Boolean

iniCell = "$d$3"

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 & "Consulta " & Format(R, "00000") & ".txt" For Output As #1: SW = False

  For j = 1 To 100

    If Vec(j, 1) = "" Then Exit For

    If SW Then Print #1, ""

    'Write #1, Vec(j, 1)

     Print #1, Vec(j, 1);

SW = True

  Next

  Close

Next