Hello I'm trying to make a Macro that can copy the text between 2 arbitrary words. The Macro I found(and slightly altered) works perfectly, with 1 problem. I don't know how to loop it so that it finds all instances of the words in the entire Document.

To show exactly what the macro is intended to do here is a screenshot

https://vgy.me/tiy0Tq.png

There are a lot of these small paragraphs in a big Word file, and I need to select them and copy them to a new Word File.

Sub FindTextBetweenWords()

Dim lngStart As Long
Dim lngEnd As Long
Dim newDoc As Document
Dim curDoc As Document
Set curDoc = ActiveDocument
Set newDoc = Documents.Add
curDoc.Activate
Selection.HomeKey Unit:=wdStory

With Selection.Find


.ClearFormatting
.Wrap = wdFindStop
.MatchCase = False
.Text = "References:"
If .Execute = False Then
MsgBox "'References' not found.", vbExclamation
Exit Sub
End If
lngStart = Selection.Start
Selection.Collapse Direction:=wdCollapseEnd
.Text = "Working paper No"
If .Execute = False Then
MsgBox "'Working paper No' not found.", vbExclamation
Exit Sub
End If
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
lngEnd = Selection.End
End With

newDoc.Content.Paste
curDoc.Activate
End Sub


So this thing works and does the job pretty much perfectly. But I can't make it loop for the entirety of the Document. I'll appreciate some help. Thank you in advance.