Help with Copying Footers into New Document

[umchemist]

Hi Everyone,

Big time reader, first time poster.

Can anyone help with editing this code? I works well, but only copy's text which is highlighted- I need to change it so it copies all text in the footer, and also copies its formatting, whether is be bold, italics, highlighted, etc.

Any help is very much appreciated!

Sub CopyAllContentInFootertoNewDocument()
Dim rWrd As Range ' a word
Dim Source As Document
Dim Target As Document
Dim sTmp As String
Dim FtnI As Long ' footnote index
Dim FntP As Long ' footnote page
Dim rFtn As Footnote
Dim rTmp As Range
Set Source = ActiveDocument
Set Target = Documents.Add
Source.Activate
For Each rFtn In ActiveDocument.Footnotes
Set rTmp = rFtn.Range
'rTmp.Select
If rTmp.HighlightColorIndex <> 0 Then
FtnI = rFtn.Index
FntP = rFtn.Range.Information(wdActiveEndPageNumber)
sTmp = "Footnote " & FtnI & ", " & _
"page " & FntP & ": "
With Target.Range
.InsertAfter sTmp
End With
For Each rWrd In rFtn.Range.Words
If rWrd.HighlightColorIndex <> 0 Then
rWrd.Select
rWrd.Copy
Target.Range.Select
selection.EndKey Unit:=wdStory
selection.Paste
End If
Next
End If
Target.Range.InsertAfter vbCrLf
Next
End Sub

[fumei]

Let's go through this.
Set Source = ActiveDocument
Set Target = Documents.Add
Source.Activate
For Each rFtn In ActiveDocument.Footnotes
You set a Source document object as ActiveDocument...then use ActiveDocument. Why make a document object if you are not going to use it? Further, one of the main points of creating (and using) a document object is that you do NOT have to Activate anything.
Set Source = ActiveDocument
Set Target = Documents.Add
For Each rFtn In Source.Footnotes


You state: "so it copies all text in the footer" but you do nothing with footers. It seems you are actioning footnotes. Which is it?