Excel alle Zellen einer Spalte in separate Textdateien exportieren

das Dokument enthält A1 bis A 23567 Zeilen. Es sollen also 23567 .txt-Dateien mit jeweils dem Inhalt einer Zelle entstehen.

Ich habe dafür folgendes Script verwendet:

Sub ErstelleDateien()
Ziel = "D:\Mein Ordner"
Stellen = 3
Typ = ".txt"
AbZeile = 1
Spalte = "F"
Zeile = AbZeile
Nr = 1000001
Set fso = CreateObject("Scripting.FileSystemObject")
If Right(Ziel, 1) <> "\" Then Ziel = Ziel & "\"
Do While Cells(Zeile, Spalte).Value <> ""
fso.CreateTextFile(Ziel & Right(Nr, Stellen) & Typ).Write Cells(Zeile, Spalte).Value
Zeile = Zeile + 1
Nr = Nr + 1
Loop
End Sub

Leider erhalte ich damit nur die ersten 71 Dateien.
Kenne mich mit dem Thema nicht aus und weiss deshalb nicht, ob es sich um ein Kapazitätsproblem handelt (=es können nur 71 Dateien auf einmal ausgelesen werden) oder ob es am verwendeten Script liegt.

Kann mir jemand helfen?

Viele Grüße
Blümchen

Do While Cells(Zeile, Spalte).Value <> ""   

 
For i = 1 To ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
.......
Next i

Sub ErstelleDateien()
Ziel = "D:\Mein Ordner"  
Stellen = 5
Typ = ".txt"  
VonZeile = 1
BisZeile = 23567
Spalte = "F"  

Nr = 1000001
Set fso = CreateObject("Scripting.FileSystemObject")  
If Right(Ziel, 1) <> "\" Then Ziel = Ziel & "\"  

For Zeile = VonZeile To BisZeile
    fso.CreateTextFile(Ziel & Right(Nr, Stellen) & Typ).Write Cells(Zeile, Spalte).Value
    Nr = Nr + 1
Next
End Sub