Try something along the lines of:
Code:
Sub Splitter()
Dim DocSrc As Document, DocTgt As Document, i As Long, j As Long, Rng As Range, StrTgt As String
Set DocSrc = ActiveDocument
With DocSrc
Set Rng = .Range(0, 0): j = 1000: StrTgt = Split(.FullName, ".doc")(0) & "_"
For i = 1 To -Int(-.ComputeStatistics(wdStatisticWords) / j)
If .Range(Rng.Start, .Range.End).ComputeStatistics(wdStatisticWords) < j Then _
j = .Range(Rng.Start, .Range.End).ComputeStatistics(wdStatisticWords)
If j = 0 Then Exit For
With Rng
.MoveEnd wdWord, j
.End = .Paragraphs.Last.Range.End
Do While .ComputeStatistics(wdStatisticWords) < j
.MoveEnd wdParagraph, wdForward
Loop
Set DocTgt = Documents.Add(Template:=DocSrc.AttachedTemplate.FullName, Visible:=False)
With DocTgt
.Range.FormattedText = Rng.FormattedText
.SaveAs2 StrTgt & i & ".docx", FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
.Close False
End With
.Collapse wdCollapseEnd
If .End = DocSrc.Range.End Then Exit For
End With
Next
End With
End Sub
The macro outputs each split to a new document, with the split occurring at the end of whichever paragraph has the 1000th word in the current block.