Sub Demo()
Application.ScreenUpdating = False
Dim i As Long, Rng As Range
With ActiveDocument
  For i = 1 To .ComputeStatistics(wdStatisticPages)
    Set Rng = .GoTo(What:=wdGoToPage, Which:=wdGoToAbsolute, Name:=i)
    Set Rng = Rng.GoTo(What:=wdGoToBookmark, Name:="\Page")
    With Rng
      With .Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = "<BRAND®[!\(]{1,5}\([!\)]@\)"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindStop
        .Format = False
        .MatchWildcards = True
        .Execute
      End With
      If .Find.Found Then
        .Text = Trim(Split(.Text, "(")(0))
      End If
    End With
  Next
End With
Application.ScreenUpdating = True
End Sub