Try:
Code:
Sub Demo()
Application.ScreenUpdating = False
Dim DocSrc As Document, DocTgt As Document, Tbl As Table, Rng As Range, FtNt As Footnote, i As Long
Set DocSrc = ActiveDocument: Set DocTgt = Documents.Add
With DocTgt
Set Tbl = .Tables.Add(Range:=.Range, Numrows:=3, NumColumns:=2, DefaultTableBehavior:=wdWord9TableBehavior)
With Tbl
.Columns(1).Cells.Merge
.Cell(1, 2).Range.Text = "Original:" & vbCr
.Cell(2, 2).Range.Text = "Copy 1:" & vbCr
.Cell(3, 2).Range.Text = "Copy 2:" & vbCr
End With
Set Rng = Tbl.Range
For i = 1 To DocSrc.Footnotes.Count - 1
.Range.Characters.Last.FormattedText = Rng.FormattedText
Next
For i = 1 To DocSrc.Footnotes.Count
With Tbl
.Cell((i - 1) * 3 + 1, 1).Range.Text = i
.Cell((i - 1) * 3 + 1, 2).Range.Characters.Last.Text = DocSrc.Footnotes(i).Range.FormattedText
.Cell((i - 1) * 3 + 2, 2).Range.Characters.Last.Text = DocSrc.Footnotes(i).Range.FormattedText
.Cell((i - 1) * 3 + 3, 2).Range.Characters.Last.Text = DocSrc.Footnotes(i).Range.FormattedText
End With
Next
End With
Application.ScreenUpdating = True
End Sub