Microsoft Office Forums - View Single Post - How To Auto Copy And Paste With A Footnote In Its Place.

gmayor · 01-14-2022, 10:37 PM

If your document is formatted using styles to create the inter-line spacing then

Code:

Sub Macro1()
Const sFind As String = "Footnote"
Dim sNote As String
Dim oRng As Range
    Set oRng = ActiveDocument.Range
    With oRng.Find
        Do While .Execute(sFind)
            sNote = ""
            With oRng
                .End = .Paragraphs(1).Range.End
                .Text = ""
                .End = .Paragraphs(1).Range.End - 1
                sNote = .Text
                .End = .End + 1
                .Text = ""
                .End = .Paragraphs(1).Range.End - 1
                sNote = sNote & " - " & .Text
                .End = .End + 1
                .Text = ""
                .End = .Paragraphs(1).Range.End - 1
                .MoveEndWhile Chr(46)
                ActiveDocument.Footnotes.Add Range:=oRng, Text:=sNote
                .Collapse 0
            End With
        Loop
    End With
lbl_Exit:
    Set oRng = Nothing
    Exit Sub
End Sub

If you have empty paragraphs to provide the spacing, add

Code:

oRng.Text = Replace(oRng.Text, vbCr & vbCr, vbCr)
oRng.ParagraphFormat.SpaceAfter = 12

immediately after the line

Code:

Set oRng = ActiveDocument.Range