Sub ExtractText()
'Seb AllenThursday, 26 March 2015 at 16:13 UTC
Dim oSource As Document
Dim oTarget As Document
Dim oRng As Range
    Set oSource = ActiveDocument
    'Create a document to hold the extracts
    Set oTarget = Documents.Add
    'replace line breaks with paragraph breaks
    Set oRng = oSource.Range
    oRng.Text = Replace(oRng.Text, Chr(11), Chr(13))
    With oRng.Find
        'Find the times
        Do While .Execute(FindText:="at [0-9]{2}:[0-9]{2} UTC", _
                          MatchWildcards:=True)
            'Copy the paragraph containing the found time to the new document
            oTarget.Range.InsertAfter oRng.Paragraphs(1).Range.Text
            oRng.Collapse 0
            DoEvents
        Loop
    End With
lbl_Exit:
    Exit Sub
End Sub