Excel - Cómo dividir un archivo de excel en múltiples archivos txt

Buen día;

He intentado generar una macro que me permita dividir un archivo en Excel cada 5000 filas y convertirlas en archivos txt, pero no ha sido posible, alguna orientacion correcccion??

Sub Test()

'declarar variables
Dim wb As Workbook
Dim Obj As FileSystemObject
Dim Tx As Scripting.TextStream
Dim ThisSheet As Worksheet
Dim NumOfColumns As Integer
Dim RangeToCopy As Range
Dim RangeOfHeader As Range
Dim RowsInFile As Integer
Dim Rutarchivo As String

Rutarchivo = ThisWorkbook.Path & "\ODT_CREAR_SELLOS_AZULES_" & WorkbookCounter & ".txt"


Application.ScreenUpdating = False
Set ThisSheet = ThisWorkbook.ActiveSheet
Set Obj = New FileSystemObject
Set Tx = Obj.CreateTextFile(Rutarchivo)
NumOfColumns = ThisSheet.UsedRange.Columns.Count
WorkbookCounter = 1


RowsInFile = 5001
Set RangeOfHeader = ThisSheet.Range(ThisSheet.Cells(1, 1), ThisSheet.Cells(1, NumOfColumns))

For p = 2 To ThisSheet.UsedRange.Rows.Count Step RowsInFile - 1


Set wb = Workbooks.Add
RangeOfHeader.Copy wb.Sheets(1).Range("A1")
Set RangeToCopy = ThisSheet.Range(ThisSheet.Cells(p, 1), ThisSheet.Cells(p + RowsInFile - 2, NumOfColumns))
RangeToCopy.Copy wb.Sheets(1).Range("A2")


'Guardar el nuevo archivo
wb.SaveAs ThisWorkbook.Path & "\ODT_CREAR_SELLOS_AZULES_" & WorkbookCounter & ".txt"
wb.Close


WorkbookCounter = WorkbookCounter + 1
Next p

Application.ScreenUpdating = True
Set wb = Nothing
End Sub

No se que se supone que hace esta macro pero de lo que estoy seguro es lo que no hace "dividir un archivo en Excel cada 5000 filas y convertirlas en archivos txt"

Hay varias formas de abrir / crear un archivo plano de texto y varias formas de escribir en el.
Yo utilizo la clásica por que es la que mejor me conozco.

El código sería algo así:


No lo he probado y puede que tenga algún error de escritura.
Lo que escribe en el fichero de texto no se como queda porque tampoco se lo que escribe ni como lo ha de escribir.

Saludos.
\\//_