Sub ExportEndNotes()
Application.ScreenUpdating = False
Dim Rng As Range, DocSrc As Document, DocTgt As Document, i As Long, StrRef As String
Set DocSrc = ActiveDocument
With DocSrc
  'Unlink endnote/footnote cross-references
  For i = .Fields.Count To 1 Step -1
    If .Fields(i).Type = wdFieldNoteRef Then .Fields(i).Unlink
  Next
 'Process all endnotes
  For i = 1 To .Endnotes.Count
    'First, process the endnote ref in the document body
    Set Rng = .Endnotes(i).Reference
    With Rng
      .Collapse wdCollapseStart
      'To get the actual reference text, we need to cross-reference it!
      .InsertCrossReference wdRefTypeEndnote, wdEndnoteNumberFormatted, i, False, False
      .End = .End + 1
      StrRef = .Text
      .Fields(1).Unlink
    End With
    'Second, process the endnote ref in the endnote
    Set Rng = .Endnotes(i).Range.Paragraphs.First.Range.Words.First
    With Rng
      If .Characters.Last Like "[ " & vbTab & "]" Then .End = .End - 1
      'Overwrite the existing endnote reference
      .Text = StrRef
    End With
  Next
  'Give Word a chance to do its housekeeping
  DoEvents
  'Create the output document
  Set DocTgt = Documents.Add
  'Replicate the endnotes in the body of the output document
  DocTgt.Range.FormattedText = .StoryRanges(wdEndnotesStory).FormattedText
  'Delete the endnotes from the source document
  For i = .Endnotes.Count To 1 Step -1
    .Endnotes(i).Delete
  Next
End With
Set Rng = Nothing: Set DocTgt = Nothing: Set DocSrc = Nothing
Application.ScreenUpdating = True
End Sub