A family of Microsoft word processing software products for creating web, email, and print documents.
While Jay is sleeping...
Assuming that it is headings with the style of Heading 1 that you are interested in, then the following should do what you want:
Dim sourceDoc As Document
Dim destDoc As Document
Dim srchRg As Range
Dim copyRg As Range
Dim searchTerm As String
Dim count As Long
Dim i As Long
Dim rngfound As Range
searchTerm = InputBox("Enter word or phrase to find:", "Search Term")
If searchTerm = "" Then Exit Sub
Set sourceDoc = ActiveDocument
Set destDoc = Documents.Add
Set srchRg = sourceDoc.Range
count = 0
With srchRg.Find
.Text = searchTerm
While .Execute
count = count + 1
Set copyRg = destDoc.Range
copyRg.Collapse wdCollapseEnd
If srchRg.Style = "Heading 1" Then
Set rngfound = srchRg.Paragraphs(1).Range
rngfound.End = sourceDoc.Range.End
With rngfound
For i = 2 To .Paragraphs.count
If .Paragraphs(i).Style = "Heading 1" Or InStr(.Paragraphs(i).Range, searchTerm) > 0 Then
rngfound.End = rngfound.Paragraphs(i - 1).Range.End
Exit For
End If
Next i
End With
End If
copyRg.FormattedText = rngfound.FormattedText
Wend
End With
If count = 0 Then
destDoc.Range.Text = "No instances found"
End If