I deleted the page headings. And then ran this:
[vba]
Sub VBAX()
Dim FindRange As Word.Range
Dim NotesStart As Long
Dim NotesPara As Word.Paragraph
Dim NoteNumber As Long
Dim NotesRange() As Word.Range
Set FindRange = ActiveDocument.Content.Duplicate
FindRange.Find.Execute FindText:="Notes^p^p", Forward:=False
NotesStart = FindRange.Start
For Each NotesPara In ActiveDocument. _
Range(NotesStart, ActiveDocument.Range.End).Paragraphs
If IsNumeric(NotesPara.Range.Words(1)) Then
NoteNumber = CLng(NotesPara.Range.Words(1))
If (Not Not NotesRange) = 0 Then
ReDim NotesRange(1 To NoteNumber)
Else
If NoteNumber > UBound(NotesRange) Then
ReDim Preserve NotesRange(1 To NoteNumber)
End If
End If
Set NotesRange(NoteNumber) = NotesPara.Range.Duplicate
End If
Next
Set FindRange = ActiveDocument. _
Range(ActiveDocument.Range.Start, NotesStart)
With FindRange
Do While FindRange.Find.Execute( _
FindText:="([\?\!,.;" & ChrW(8221) & "]{1,})([0-9]{1,})", _
MatchWildcards:=True, _
ReplaceWith:=" ( \2 )\1", _
Replace:=wdReplaceOne, _
Forward:=False)
NoteNumber = ActiveDocument.Range(.Start + 3, .Start + 3).Words(1)
With .Paragraphs(1).Range
.InsertParagraphAfter
.InsertAfter NotesRange(NoteNumber).FormattedText
End With
Loop
End With
End Sub
[/vba]
Note that I look for ChrW(8221) (a curly right double quote) rather than a straight quote - and I also had to add a semicolon to the list of characters.
Other than that it appears to work on the sample doc.