Sub TableSplitter()
Application.ScreenUpdating = False
Dim Tbl As Table, RngFnd As Range, StrFindTxt As String
StrFindTxt = InputBox(",")
If Trim(StrFindTxt) = "" Then Exit Sub
For Each Tbl In ActiveDocument.Tables
  Set RngFnd = Tbl.Range
  With RngFnd.Find
    .ClearFormatting
    .Text = StrFindTxt
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    Do While .Execute
      With RngFnd.Duplicate
        'The next two lines break the table *after* the found row
        If .Cells(1).RowIndex < .Tables(1).Rows.Count Then
          .Tables(1).Split .Cells(1).RowIndex + 1
        End If
        'The next two lines break the table *before* the found row
        If .Cells(1).RowIndex > 1 Then
          .Tables(1).Split .Cells(1).RowIndex
        End If
        .Collapse (wdCollapseEnd)
      End With
    Loop
  End With
Next
Set RngFnd = Nothing
Application.ScreenUpdating = True
End Sub