To process the current table 

Sub Macro1()
Dim oCol As New Collection
Dim oTable As Table
Dim oRng As Range
Dim lngIndex As Long
Dim sList As String: sList = ""
    Set oTable = Selection.Tables(1)
    Set oRng = oTable.Range
    oRng.Select
    With oRng.Find
        Do While .Execute(FindText:="<[A-Z]{1,8}>", MatchWildcards:=True)
            If oRng.InRange(oTable.Range) Then
                On Error Resume Next
                oCol.Add oRng.Text, oRng.Text
                On Error GoTo 0
                oRng.Collapse wdCollapseEnd
            End If
        Loop
    End With
    Set oRng = oTable.Range
    oRng.MoveEndUntil Chr(13)
    oRng.Collapse wdCollapseEnd

    For lngIndex = 1 To oCol.Count
        sList = sList & oCol(lngIndex)
        If lngIndex < oCol.Count Then
            sList = sList & vbCr
        End If
    Next lngIndex
    oRng.Text = sList
lbl_Exit:
    Set oTable = Nothing
    Set oRng = Nothing
    Exit Sub
End Sub