Sub Macro1()
Dim oRng As Range
Dim sText As String
    Selection.HomeKey wdStory
    Selection.Find.ClearFormatting
    With Selection.Find
        Do While .Execute(findText:="\[[0-9]{1,}\]", _
                          MatchWildcards:=True, _
                          Wrap:=wdFindStop, _
                          Forward:=True) = True
            Set oRng = Selection.Range
            sText = sText & oRng.Text & Chr(32)
        Loop
    End With
    ActiveDocument.Range.InsertAfter vbCr & sText
lbl_Exit:
    Exit Sub
End Sub