Sub Demo()
Application.ScreenUpdating = False
Dim Rng As Range, StrOut As String
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "\(*\)"
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchWildcards = True
  End With
  Do While .Find.Execute
    With .Duplicate
      Set Rng = .Characters.Last
      Do While InStr(2, .Text, "(", vbTextCompare) > 0
        .MoveEndUntil ")", wdForward
        .End = .End + 1
        .Start = .Start + 1
        .MoveStartUntil "(", wdForward
        Set Rng = .Characters.Last
      Loop
    End With
    .End = Rng.End
    StrOut = StrOut & vbCr & .Text
    .Collapse wdCollapseEnd
  Loop
End With
Documents.Add
ActiveDocument.Range.InsertAfter StrOut
Application.ScreenUpdating = True
End Sub