Macro to highlight wildcard phrase, copy and paste into new doc.

[MaryTom]

I handle documents with embedded tags enclosed in angled brackets, and I need to see the tags separately to ensure they are correct. I can use wildcard search to find all the tags, but I am trying to do a macro to find the tags, then copy/paste into a new document so all I have is a list of tags in the separate document. I assumed that using Find to highlight, then selecting all highlighted text and copy and pasting would be the easiest way, but I cannot get it to work. It hangs and crashes Word, though it seems to highlight. I put in the message box to see if it gets there, and it never does. I only need the one wildcard search term, but I could not figure out how to get it to search through the whole document one time and highlight, so I came up with what you see below. Can anyone help me correct this macro? I feel like it should be simple.

Sub temp()
'
' t' Macro to find the codes and highlight them. Then you can copy all highlighted text into a new doc and erase highlight.
Dim Word As range
Dim WordCollection(0) As String
Dim Words As Variant

'Define list. If you add or delete, change value above in Dim statement.
WordCollection(0) = "[<]*[>]"
'WordCollection(1) = ""
'Set highlight color.
Options.DefaultHighlightColorIndex = wdYellow

'Clear existing formatting and settings in Find feature.
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting

'Set highlight to replace setting.
Selection.Find.Replacement.Highlight = True

'Find words & Highlight
For Each Word In ActiveDocument.Words
For Each Words In WordCollection
With Selection.Find
.Text = Words
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = True
.MatchSoundsLike = False


.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Next
Next
MsgBox "Finished search. All codes should be highlighted. Will now create new document."

'Find all highlighted & copy it ???

'New doc
'Documents.Add Template:="Normal", NewTemplate:=False, DocumentType:=0
' Selection.Paste
End Sub

[macropod]

Try:

Sub Demo()
Application.ScreenUpdating = False
Dim DocSrc As Document, DocTgt As Document
Set DocSrc = ActiveDocument
Set DocTgt = Documents.Add
With DocSrc.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "\<*\>"
    .Replacement.Text = ""
    .Format = False
    .Forward = True
    .Wrap = wdFindStop
    .MatchWildcards = True
    .Execute
  End With
  Do While .Find.Found
    DocTgt.Range.InsertAfter .Text & vbCr
    .Collapse wdCollapseEnd
    .Find.Execute
  Loop
End With
Application.ScreenUpdating = True
End Sub

PS: When posting code, please use the code tags, indicated by the # button on the posting menu. Without them, your code loses much of whatever structure it had.

[MaryTom]

Ah, thank you so much! That seems to be exactly what I need. I appreciate the tip about the hashtags on the menu for codes too.

You're awesome!