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

[Владомир]

Добрый вечер. Бьюсь уже очень долго и ничего пока не выходит. Помогите, пожалуйста, исправить макрос для MS Word 2010 чтобы он мог объединять ячейки по первому столбцу. Алгоритм такой: В таблице в первом столбце есть несколько заполненных ячеек, а за ними пустые ячейки (количество всегда разное). Необходимо объединить каждую заполненную ячейку в столбце с пустыми ячейками следующими за ней. И так далее. Но нужно оставить без объединения ячейки заполненные. Пример файла прилагаю.
Пока получилось объединить первую заполненную ячейку с ячейками пустыми, которые идут за заполненной. Однако при дальнейшем выполнении цикла выскакивает ошибка, что такого семейства не существует. Понимаю, что дело в условии, но не могу его сделать правильным. Пример макроса нашел в сети, а исправит не хватает знаний. Помогите!
Вот макрос

Sub MergeRowsByColumns()
  Dim oTbl As Table, iStart As Long, iEnd As Long, i#, j#, k#, iRowsCnt
  Set oTbl = Selection.Tables(1)
  iRowsCnt = oTbl.Rows.Count
  Application.ScreenUpdating = False  
  Do: i = i + 1
    'Ищем пустую ячейку в первом столбце. Запоминаем номер предыдущей строки    
    If Len(oTbl.Cell(i + 1, 1).Range.Text) <= 2 Then
    
      iStart = oTbl.Cell(i, 1).RowIndex
      'Начиная с этой строки ищем заполненную ячейку в первом столбце и также запоминаем номер _
      предыдущей строки
      For j = iStart + 1 To iRowsCnt
        If Len(oTbl.Cell(j, 1).Range.Text) > 2 Or j = iRowsCnt Then
          iEnd = IIf(j = iRowsCnt, j, oTbl.Cell(j, 1).Previous.RowIndex)
          
          
            'Объединяем все строки по столбцу
            ActiveDocument.Range(oTbl.Cell(iStart, k).Range.Start, oTbl.Cell(iEnd, k).Range.End).Select
            Selection.Cells.Merge
            
            'Заменяем знак абзаца на пробел
            Selection.Find.Execute findtext:="^0013", replacewith:="^0032", Replace:=wdReplaceAll          
          
          'пересчитываем количество строк после объединения
          iRowsCnt = iRowsCnt - (iEnd - iStart)         
          Exit For
        End If
      Next j
    End If
  Loop While i <> iRowsCnt
  Application.ScreenUpdating = True
End Sub