you may also try this:
Public Sub Split_Text_File()
Dim FSO As Object
Dim TSRead As Object, TSWrite As Object
Dim inputFile As Variant, outputFile As String
Dim part As Long, i As Long, n As Long, p As Long
Dim maxRows As Long
Dim outputlines() As String
'arnelgp
Dim hdr(1) As String, sValue As String
inputFile = Application.GetOpenFilename(Title:="Select a text file to be split into separate parts")
If inputFile = False Then Exit Sub
maxRows = Application.InputBox("Max number of lines/rows?", Type:=1)
If maxRows = 0 Then Exit Sub
ReDim outputlines(maxRows + 2 - 1) As String
p = InStrRev(inputFile, ".")
part = 0
n = 0
Set FSO = CreateObject("Scripting.FileSystemObject")
Set TSRead = FSO.OpenTextFile(inputFile)
'get the header
Do While Not TSRead.AtEndOfStream
sValue = TSRead.ReadLine
hdr(n) = sValue
n = n + 1
If n > 1 Then
Exit Do
End If
Loop
n = 0
'loop till end of file
While Not TSRead.AtEndOfStream
outputlines(n + 2) = TSRead.ReadLine
n = n + 1
If n = maxRows Then
part = part + 1
outputlines(0) = hdr(0): outputlines(1) = hdr(1)
outputFile = Left(inputFile, p - 1) & " PART" & part & Mid(inputFile, p)
Set TSWrite = FSO.CreateTextFile(outputFile, True)
TSWrite.Write Join(outputlines, vbCrLf)
TSWrite.Close
ReDim outputlines(maxRows + 2 - 1) As String
n = 0
End If
Wend
TSRead.Close
If n > 0 And Len(Trim$(outputlines(n - 1) & "")) <> 0 Then
ReDim outputlines2(n + 2 - 1) As String
outputlines2(0) = hdr(0): outputlines2(1) = hdr(1)
For i = 0 To n - 1
outputlines2(i + 2) = outputlines(i)
Next
part = part + 1
outputFile = Left(inputFile, p - 1) & " PART" & part & Mid(inputFile, p)
Set TSWrite = FSO.CreateTextFile(outputFile, True)
TSWrite.Write Join(outputlines2, vbCrLf)
TSWrite.Close
End If
MsgBox "Done"
End Sub