Macro for copying text between two Words.

Demonic · #1 02-05-2017, 03:58 PM

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.

gmaxey · #2 02-06-2017, 07:47 PM

Code:

Sub FindTextBetweenWords()
Dim oRng As Word.Range, oPasteRng As Range
Dim oDoc As Document, oTargetDoc As Document
  Set oDoc = ActiveDocument
  Set oTargetDoc = Documents.Add
  oDoc.Activate
  Set oRng = oDoc.Range
  With oRng.Find
    .ClearFormatting
    .Wrap = wdFindStop
    .MatchCase = False
    .Text = "References:*Working paper No"
    .MatchWildcards = True
    While .Execute
       oRng.Select
       Selection.EndKey Unit:=wdLine, Extend:=wdExtend
       Selection.Copy
       Set oPasteRng = oTargetDoc.Range
       oPasteRng.Collapse wdCollapseEnd
       oPasteRng.Paste
       oRng.Collapse wdCollapseEnd
    Wend
  End With
lbl_Exit:
  Exit Sub
End Sub

Demonic · #3 02-08-2017, 01:16 AM

This worked really well, thank you.

realist · #4 07-18-2017, 09:08 PM

I'm trying to do the same thing as the OP, but I think the code given by gmaxey might not be working for me because of special characters. I'm trying to search within HTML code to extract any text in between this code:

<font class="module-font-22" style="font-size: 22.0px;" color="#333333">

and this code:

</font>

Any ideas?

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Copying Certain Text From Numerous Cells using Macro	Sean_Needs_Help	Excel	3	11-08-2016 04:39 PM
Extracting multiple words from one cell into individual rows while copying all other data	randyaserve	Excel Programming	4	10-05-2015 09:52 AM
Copying words without initial word space	bertietheblue	Word	2	11-03-2013 04:46 PM
Macro for Copying Charts to Powerpoint	bremen22	Excel Programming	1	10-01-2013 03:27 PM
Macro for replacing, copying and undoing.	vthomeschoolmom	Word VBA	1	12-05-2012 07:41 AM