How To Auto Copy And Paste With A Footnote In Its Place.

[Abbas]

Views: 21 Size: 28.6 KB">Word.png

I would like to know if there is a way to do what's in the picture which is:-

1- if "footnote" found go to the next sentence copy it and reformat it and put it in foot note in one line.

2- if no "footnote" word found copy and paste it before the footnote.

[gmayor]

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

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

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

immediately after the line

Set oRng = ActiveDocument.Range

[Abbas]

Thank you so much for helping me. But, there is a problem which is described in the picture below.

Please have a look at the attached file, if you needed that.
BeforeAndAfterRunningTheMacro.png

AfterRunningMacro.docm

Before.docm

[gmayor]

The example document layout bears no relationship to the screenshot in your original message, so it comes as no surprise that the code intended for the screenshot layout doesn't work with the document layout. For that you would need

Sub Macro1()
Const sFind As String = "Footnote"
Dim sNote As String
Dim oRng As Range, oNote As Range
    Set oRng = ActiveDocument.Range
    With oRng.Find
        Do While .Execute(sFind)
            sNote = ""
            With oRng
                .End = .Paragraphs(1).Range.End
                .Text = ""
                .MoveStart wdParagraph
                .End = .Paragraphs(1).Range.End
                .MoveEnd wdParagraph
                Set oNote = .Paragraphs(1).Range
                oNote.End = oNote.End - 1
                sNote = oNote.Text
                Set oNote = .Paragraphs(2).Range
                oNote.End = oNote.End - 1
                sNote = sNote & " - " & oNote.Text
                .Text = ""
                .Start = .Start - 1
                .Collapse 1
                .Footnotes.Add oRng, , sNote
                .Start = .Start + 1
                .End = ActiveDocument.Range.End
            End With
        Loop
    End With
lbl_Exit:
    Set oRng = Nothing
    Exit Sub
End Sub

[Abbas]

Thank you so much for your help! It's absolutely amazing. I really appreciate that you took the time to reply and I really appreciate your help.

Have a great day,