Sub ScratchMacro()
Dim oTbl As Word.Table, oTblTarget As Table
Dim arrIndex() As Long
Dim lngIndex As Long
Dim oRng As Word.Range
  Set oTbl = ActiveDocument.Tables(1)
  oTbl.Range.Copy
  Set oRng = ActiveDocument.Bookmarks("bmRows").Range
  If oRng.Tables.Count = 1 Then
    oRng.Tables(1).Delete
  End If
  oRng.Paste
  Set oTblTarget = oRng.Tables(1)
  ActiveDocument.Bookmarks.Add "bmRows", oTblTarget.Range
  ReDim arrIndex(0)
  For lngIndex = oTbl.Rows.Count To 1 Step -1
    If Not Left(oTbl.Cell(lngIndex, 1).Range.Text, Len(oTbl.Cell(lngIndex, 1).Range.Text) - 2) = "High" Then
      arrIndex(UBound(arrIndex)) = oTbl.Rows(lngIndex).Index
      ReDim Preserve arrIndex(UBound(arrIndex) + 1)
    End If
  Next lngIndex
  For lngIndex = 0 To UBound(arrIndex) - 1
    oTblTarget.Rows(arrIndex(lngIndex)).Delete
  Next lngIndex
End Sub