Sub Macro1()
Dim orng As Range
    Set orng = ActiveDocument.Range
    With orng.Find
        Do While .Execute(findText:="CEO*together.", MatchWildcards:=True)
            orng.Bookmarks.Add "mark"
            Exit Sub
        Loop
    End With
End Sub