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