ต้องการแบ่งไฟล์ csv ออกเป็น ครั้ง 1000 แถวใช้อะไรจะเร็วที่สุดครับ

Sub MyMacro()
    For n = 1 To 10
    Selection.MoveDown Unit:=wdLine, Count:=1000, Extend:=wdExtend
    Selection.Cut
    Documents.Add DocumentType:=wdNewBlankDocument
    Selection.PasteAndFormat (wdPasteDefault)
        FName = "output" & n & ".csv"
    ActiveDocument.SaveAs FileName:=FName, FileFormat:=wdFormatText, _
        LockComments:=False, Password:="", AddToRecentFiles:=True, WritePassword _
        :="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:=False, _
        SaveNativePictureFormat:=False, SaveFormsData:=False, SaveAsAOCELetter:= _
        False, Encoding:=874, InsertLineBreaks:=False, AllowSubstitutions:=False, _
         LineEnding:=wdCRLF, AddBiDiMarks:=False
    ActiveDocument.Close
    Next n
End Sub