Ah, the joys of trying to adapt code written for one thing to do something else! Try:
Code:
Sub TextSplitter()
Dim Rng As Range
Application.ScreenUpdating = False
With ActiveDocument
Set Rng = .Range(0, 0)
Do
With Rng
On Error GoTo ErrExit
.MoveEndUntil cset:=vbCr, Count:=wdForward
If Len(.Text) > 500 Then
.End = .Start + 500
.End = .Start + InStrRev(Rng.Text, ".") + 1
If .Characters.Last.Text <> vbCr Then
.Characters.Last.Delete
.InsertAfter vbCr & "*** " & vbCr
End If
End If
DoEvents
.Start = .Paragraphs.Last.Next.Range.Start
End With
Loop Until Rng Is Nothing
ErrExit:
With .Range.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "*** " & vbCr
.Replacement.Text = "*** "
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Execute Replace:=wdReplaceAll
End With
End With
Set Rng = Nothing
Application.ScreenUpdating = True
End Sub