On second thought this might be better. This way you can use non-uniform tables:
Code:
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