Sub SplitTables()
Application.ScreenUpdating = False
Dim t As Long, c As Long
With ActiveDocument
  On Error Resume Next
  For t = .Tables.Count To 1 Step -1
    With .Tables(t).Range
      For c = .Cells.Count To 1 Step -1
        With .Cells(c)
          If .RowIndex > 1 Then
            If Split(.Range.Text, vbCr)(0) = "Tree Number" Then .Range.InsertBreak (wdColumnBreak)
          End If
        End With
      Next
    End With
  Next
End With
Application.ScreenUpdating = True
End Sub