Macro to search for a particular word, copy the entire paragraph to a new document

macropod · #1 08-16-2017, 02:10 AM

Try:

Code:

Sub Demo()
Application.ScreenUpdating = False
Dim strFnd As String, DocSrc As Document, DocTgt As Document
strFnd = InputBox("What is the Text to Find")
If Trim(strFnd) = "" Then Exit Sub
Set DocSrc = ActiveDocument: Set DocTgt = Documents.Add
With DocSrc.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = strFnd
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    .Execute
  End With
  Do While .Find.Found
    DocTgt.Characters.Last.FormattedText = .Paragraphs(1).Range.FormattedText
    .End = .Paragraphs(1).Range.End
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
End With
Application.ScreenUpdating = True
End Sub

EskoBrummel · #2 10-25-2019, 06:40 AM

Greetings,
This is a very useful macro, though is it possible to add the following features?
- Add the page number and document title where the paragraph is located above each paragraph;
- Enable search and extraction for multiple terms;
- Performing this macro over multiple documents.

Any of these features would be greatly appreciated!

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Create Word macro to delete text throughout the entire document	JTell	Word VBA	8	07-06-2022 12:19 PM
Copy the entire paragraph in wildcards	asderam	Word VBA	0	01-28-2021 05:54 PM
Delete entire paragraph after key word	jeffreybrown	Word	2	07-27-2018 02:29 PM
How to select and copy to clipboard an entire document except for a paragraph and keep formatting	TD_123	Word VBA	7	06-16-2015 03:30 PM
align just ONE paragraph, not the entire document	vcolemonts	Word	1	02-18-2014 09:57 AM