![]() |
#2
|
||||
|
||||
![]()
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
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
Tags |
extract, footnotes, table |
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
![]() |
sai | Word VBA | 12 | 05-11-2020 04:29 AM |
![]() |
ad.dias | Word Tables | 6 | 08-27-2017 02:42 PM |
![]() |
jbaranao | Word | 3 | 02-08-2015 08:57 PM |
Extract duplicates in table | goran.c | Excel | 0 | 01-21-2015 12:47 AM |
automatically extract footnotes into new file and apply character format to footnote | hrdwa | Word | 0 | 02-27-2010 03:16 AM |