Sub Demo()
Dim Rng As Range, Start
Const Pause As Long = 2#
Recycle:
With ActiveDocument.Range
  Set Rng = .Characters.First
  
  Do While Rng.End < .End - 1
    Start = Timer
    Do While Timer < Start + Pause
      DoEvents    ' Yield to other processes.
      Set Rng = Rng.GoTo(What:=wdGoToBookmark, Name:="\Line")
      Rng.Select
    Loop
    If Rng.End = .End - 1 Then GoTo Recycle
    Rng.Collapse wdCollapseEnd
  Loop
End With
End Sub