Удаление пустых ячеек в Word

[Didar]

Тут такой вопрос: дана таблица, 6 столбцов и много строк. Первый столбец полностью заполнен текстом, а остальные местами. Как удалить пустые ячейки, чтобы в итоге осталось 2 столбца с текстами.

[shanemac51]

на одной строке не более 2 ячеек ?????

[Didar]

получается что да

[Didar]

В итоге должно получиться что-то вроде того:

[shanemac51]

один из вариантов

Sub m110114_1021()
Dim j1, j1k, j2, j2k, s1, s1a, s2, ss
j1k = Word.ActiveDocument.Tables(1).Rows.Count
j2k = Word.ActiveDocument.Tables(1).Columns.Count
s1 = Word.ActiveDocument.Name
s2 = Word.ActiveDocument.FullName
j1 = 0
Do While 2 > 1
j2 = InStr(j1 + 1, s2, "\")  'выделение пути
If j2 > 0 Then
j1 = j2
Else
s2 = Mid(s2, 1, j1) & "00.doc"   ' имя док2
Exit Do
End If
Loop
'''''''''''''''''''''''''''''''''создание дос2
  Documents.Add Template:="Normal", NewTemplate:=False, DocumentType:=0
  Word.ActiveDocument.SaveAs s2
  s2 = Word.ActiveDocument.Name
'''''''''''''''''''''''''''''''''создание таб
  ActiveDocument.Tables.Add Range:=Selection.Range, _
  NumRows:=j1k, NumColumns:=2, _
  DefaultTableBehavior:=wdWord9TableBehavior, _
  AutoFitBehavior:=wdAutoFitContent

j1 = 0
Do While j1 < j1k
j1 = j1 + 1
s1a = " " & Word.Documents(s1).Tables(1).Rows(j1).Cells(1).Range.Text
s1a = Mid(s1a, 1, Len(s1a) - 2)

Word.Documents(s2).Tables(1).Rows(j1).Cells(1).Range.Text = Trim(s1a)

ss = ""
j2 = 1
Do While j2 < j2k
j2 = j2 + 1
s1a = " " & Word.Documents(s1).Tables(1).Rows(j1).Cells(j2).Range.Text
s1a = Mid(s1a, 1, Len(s1a) - 2)
ss = Trim(ss) & s1a
Loop
Word.Documents(s2).Tables(1).Rows(j1).Cells(2).Range.Text = ss
Loop
Word.Documents(s2).Activate
End Sub

[Didar]

Спасибо! Разобрался...