Sub MakeEndNotes()
Dim RngSel As Range, RngFnd As Range, StrNote As String
Application.ScreenUpdating = False
With Selection
  Set RngSel = .Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .MatchWildcards = True
    .Wrap = wdFindContinue
    .Forward = True
    .Text = "\<[!\>\<]{1,}\>"
    Do While .Execute = True
      Set RngFnd = ActiveDocument.Range(Start:=Selection.Start, End:=Selection.End)
      StrNote = Mid(RngFnd.Text, 2, Len(RngFnd.Text) - 2)
      ActiveDocument.Endnotes.Add RngFnd, , StrNote
      RngFnd.Text = vbNullString
    Loop
  End With
End With
RngSel.Select
Set RngFnd = Nothing: Set RngSel = Nothing
Application.ScreenUpdating = True
End Sub