Sub Macro15()
Application.ScreenUpdating = False
Dim Rng As Range, i As Long
With ActiveDocument.Tables(1)
  Set Rng = .Range
  With .Range
    With .Find
      .ClearFormatting
      .Replacement.ClearFormatting
      .Text = "#"
      .Replacement.Text = ""
      .Forward = True
      .Wrap = wdFindStop
      .Format = False
      .MatchCase = False
      .MatchWholeWord = False
      .MatchWildcards = False
      .MatchSoundsLike = False
      .MatchAllWordForms = False
      .Execute
    End With
    If .Find.Found = True
      .MoveEnd Unit:=wdCell, Count:=1
      .Text = vbNullString
    End If
  End With
End With
Application.ScreenUpdating = True
End Sub