Sub Demo()
Application.ScreenUpdating = False
Dim i As Long, j As Long, RngPara As Range, RngTemp As Range
With ActiveDocument
  j = .Paragraphs.Count
  For i = 1 To j
    Set RngPara = .Paragraphs(i).Range
    Set RngTemp = .Paragraphs(i).Range
    With RngPara
      While .Paragraphs.Last.Range.ComputeStatistics(wdStatisticWords) > 2000
        Set RngTemp = .Paragraphs.Last.Range
        With RngTemp
          .End = .Start
          .MoveEnd wdWord, 2000
          While .ComputeStatistics(wdStatisticWords) <> 2000
            .MoveEnd wdWord, 2000 - .ComputeStatistics(wdStatisticWords)
          Wend
          .InsertAfter vbCr & "Continuance ... "
          j = j + 1
        End With
      Wend
    End With
  Next
End With
Application.ScreenUpdating = True
End Sub