Sub Test()
Application.ScreenUpdating = False
Dim Fld As Field, EndNtRng As Range, FldRng As Range, i As Long, j As Long
Dim Rng As Range, StrOld As String, StrNew As String
With ActiveDocument
  For Each Fld In .Fields
    If Fld.Type = wdFieldNoteRef Then
      Set FldRng = Fld.Code
      i = Fld.Result
      While FldRng.Fields.Count = 0
        FldRng.End = FldRng.End + 1
      Wend
      Set EndNtRng = .Endnotes(i).Reference
      If EndNtRng.End > FldRng.End Then
        StrOld = FldRng.Fields(1).Code.Text
        FldRng.Fields(1).Delete
        EndNtRng.Cut
        FldRng.Paste
        FldRng.Style = "EndNote Reference"
        j = FldRng.Endnotes(1).Index
        EndNtRng.InsertCrossReference ReferenceType:="Endnote", ReferenceKind:= _
          wdEndnoteNumberFormatted, ReferenceItem:=j, InsertAsHyperlink:=True
        If FldRng.Characters.First = " " Then FldRng.Characters.First = vbNullString
        StrNew = EndNtRng.Words.First.Fields(1).Code.Text
        ActiveWindow.View.ShowFieldCodes = True
        For Each Rng In .StoryRanges
          With Rng.Find
            .ClearFormatting
            .Replacement.ClearFormatting
            .Text = StrOld
            .Replacement.Text = StrNew
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = True
            .MatchWholeWord = True
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
            .Execute Replace:=wdReplaceAll
          End With
          Rng.Fields.Update
        Next
        ActiveWindow.View.ShowFieldCodes = False
      End If
    End If
  Next
End With
Application.ScreenUpdating = True
End Sub