Sub TextSplitter2()
  Dim Rng As Range, iStep As Long, iStart As Long, iEnd As Long
  Application.ScreenUpdating = False
  With ActiveDocument
    iStep = 500
    iStart = 0
    Do While iStart < .Range.End - iStep
      If iStart + iStep > .Range.End Then
        iEnd = .Range.End
      Else
        iEnd = iStart + iStep
      End If
      Set Rng = .Range(iStart, iStart + iStep)
      If Rng.Characters.Last.Text = vbCr Then
        iStart = iStart + iStep
      Else
        Set Rng = .Range(Rng.Sentences.Last.Start, Rng.Sentences.Last.Start)
        Rng.InsertAfter vbCr & "*** "
        iStart = Rng.End
      End If
    Loop
  End With
  Set Rng = Nothing
  Application.ScreenUpdating = True
End Sub