Sub Demo()
Application.ScreenUpdating = False
Dim Rng As Range
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = "AAA"
    .Replacement.Text = ""
    .Format = False
    .Forward = False
    .Wrap = wdFindStop
    .MatchCase = True
    .MatchWholeWord = False
    .MatchWildcards = False
  End With
  Do While .Find.Execute
    If .Information(wdWithInTable) = True Then
      Set Rng = ActiveDocument.Range(0, .Tables(1).Range.Start)
      Do While Rng.Tables.Count > 0
        Rng.Tables(1).Delete
      Loop
      Exit Do
    End If
    .Collapse wdCollapseStart
  Loop
End With
Application.ScreenUpdating = True
End Sub