Option Explicit
Sub Bsp()
Dim rngCurrent As Word.Range
Dim objWord As Word.Range
Dim marke As String
Set rngCurrent = ThisDocument.Range
With rngCurrent
With .Find
.ClearFormatting
.Forward = True
.Font.Bold = True
.Text = "R"
End With
Call .Find.Execute
Do While .Find.Found
Call .Expand(WdUnits.wdSentence)
If .Words.Count >= 2 Then
Set objWord = .Words(2)
Call objWord.MoveEndWhile(" ", wdBackward)
marke = objWord
marke = Left(marke, Len(marke) - 1)
Call .Collapse
Call rngCurrent.Document.Bookmarks.Add("R" & marke, rngCurrent)
End If
Call .Move(WdUnits.wdSentence)
Call .Find.Execute
Loop
End With
End Sub