Не могу объединить пустые ячейки таблицы

q10 = 0
    nb = 0
    Do While q10 < tb9.Rows.Count 'объединение в 4-й колонке
    q10 = q10 + 1
    sss = tb9.Cell(q10, 4).Range.Text 'чтение ячейки
    If Len(sss) = 0 Then  'определение начала участка пустых ячеек
    u = q10: nb = 1
    End If
    If Len(sss) <> 0 And nb = 1 Then 'определение конца участка пустых ячеек
    u2 = q10 - 1
    tb9.Cell(u, 4).Merge MergeTo:=tb9.Cell(u2, 4) 'объединение участка пустых ячеек
    nb = 0: u = 0: u2 = 0
    End If
    Loop

Sub qwerty()
    Dim sss As Double
    MsgBox "Длина sss = " & Len(sss)
End Sub

Dim lsss As Integer
    Dim ss2 As String
    q10 = 0
    nb = 0
    Do While q10 < tb9.Rows.Count 'объединение в 4-й колонке
    q10 = q10 + 1
    ss2 = tb9.Cell(q10, 4).Range.Text
    lsss = Len(ss2)
    If lsss = 0 Then
    u = q10: nb = 1
    End If
    If Len(ss2) <> 0 And nb = 1 Then
    u2 = q10 - 1
    tb9.Cell(u, 4).Merge MergeTo:=tb9.Cell(u2, 4)
    nb = 0: u = 0: u2 = 0
    End If
    Loop

Dim lsss As Integer
    Dim ss2 As String
    q10 = 0
    nb = 0
    Do While q10 < tb9.Rows.Count 
    q10 = q10 + 1
    ss2 = tb9.Cell(q10, 4).Range.Text
    lsss = Len(ss2)
    If lsss = 2 And nb = 0 Then
    u = q10 + 1: nb = 1
    End If
    If lsss > 2 And nb = 1 Then
    u2 = q10 '- 1
    tb9.Cell(u, 4).Merge MergeTo:=tb9.Cell(u2, 4)
    nb = 0: u = 0: u2 = 0
    End If
    Loop

Sub bb()
Dim c As Cell, c1 As Cell, cp As Cell
  For Each c In ActiveDocument.Tables(1).Columns(4).Cells
    If Len(c.Range.Text) = 2 Then 'ячейка пустая
      If c1 Is Nothing Then Set c1 = c
    Else
      If Not c1 Is Nothing Then If Not c1 Is cp Then c1.Merge cp
      Set c1 = Nothing
    End If
    Set cp = c
  Next
  If Not c1 Is Nothing Then If Not c1 Is cp Then c1.Merge cp
End Sub