View Single Post
 
Old 02-10-2013, 11:18 PM
fumei fumei is offline Windows 7 64bit Office XP
Expert
 
Join Date: Jan 2013
Posts: 440
fumei is on a distinguished road
Default

Code:
Sub CopyHighlightsToOtherDoc()
Dim ThisDoc As Document
Dim ThatDoc As Document
Dim r As Range
Set ThisDoc = ActiveDocument
Set r = ThisDoc.Range
Set ThatDoc = Documents.Add
With r.Find
   .Text = ""
   .Highlight = True
   Do While .Execute(Forward:=True) = True
      ThatDoc.Range.InsertAfter r.Text & vbCrLf
      r.Collapse 0
   Loop
End With
End Sub

All highlighted text in the ActiveDocument are copied (with an added paragraph mark to separate them) to a new document.
Reply With Quote