Вставить несвязанные столбцы/строки в таблице MS Word

Sub A_ВСТАВИТЬ_НЕСВЯЗАННЫЕ_СТОЛБЦЫ_СПРАВА()
Application.ScreenUpdating = False 'СНЯТЬ МЕРЦАНИЕ ЭКРАНА
Selection.Font.Color = wdColorRed 'В ВЫДЕЛЕННЫХ ЯЧЕЙКАХ СДЕЛАТЬ ЦВЕТ ШРИФТА КРАСНЫМ
Selection.Collapse 'СНЯТЬ ВЫДЕЛЕНИЕ (ИНАЧЕ - ОШИБКА!)
    Selection.EndKey Unit:=wdRow 'ПЕРЕЙТИ В КОНЕЦ СТРОКИ
    Selection.InsertColumnsRight 'ВСТАВИТЬ СТОЛБЕЦ СПРАВА (НА СЛУЧАЙ ВЫДЕЛЕНИЯ ЯЧЕЕК ПРОСЛЕДНЕГО СТОЛБЦА)
    Selection.SelectColumn
    Selection.Font.Color = wdColorAutomatic 'В ВЫДЕЛЕННЫХ ЯЧЕЙКАХ СДЕЛАТЬ ЦВЕТ ШРИФТА АВТО (ЧТОБЫ ПОТОМ НАЙТИ В СТРОКЕ ТЕКСТ АВТО)
    Dim i As Long
    Dim j As Long
    With Selection.Tables(1)
    For j = 1 To .Columns.Count Step 1
    For i = 1 To .Rows.Count Step 1
    If Len(Selection.Tables(1).Cell(i, j).Range.Text) = 2 Then 'ЕСЛИ ЯЧЕЙКА ПУСТА
    .Cell(i, j).Range.Text = "&&&" 'ВСТАВИТЬ ТЕКСТ "&&&"
    End If
    Next i
    Next j
    End With
    Dim STR As Word.Row
For Each STR In Selection.Tables(1).Rows
    STR.Range.Characters.Last.Font.ColorIndex = wdAuto 'СДЕЛАТЬ ЗНАК КОНЦА СТРОКИ АВТО, ИНАЧЕ, ЕСЛИ ОН КРАСНЫЙ - БУДЕТ БЕСКОНЕЧНАЯ ВСТАВКА СТОЛБЦОВ!
Next STR
Dim myTable As Word.Range
Dim FLAG As Boolean
Do
    'Помещать таблицу в переменную надо именно здесь,
    'иначе поиск заканчивается (не получается зациклить).
    Set myTable = Selection.Tables(1).Range
    FLAG = False
    With myTable.Find
        .Font.ColorIndex = wdRed
        .Execute
If .Found = False Then
Exit Do
End If
        If .Found = True Then
            FLAG = True
Selection.Tables(1).Select 'ВЫДЕЛИТЬ ТАБЛИЦУ
    Selection.Find.ClearFormatting
    Selection.Find.Font.Color = wdColorRed 'НАЙТИ ТЕКСТ КРАСНОГО ЦВЕТА
With Selection.Find
        .Text = "?"
        .Forward = True
        .MatchWildcards = True
    End With
    Selection.Find.Execute
ActiveDocument.Bookmarks.Add Range:=Selection.Range, Name:="bm1" 'МАРКИРОВАТЬ 1-Ю ЯЧЕКУ С КРАСНЫМ ТЕКСТОМ В СТРОКЕ
    Selection.EndKey Unit:=wdRow, Extend:=True 'ВЫДЕЛИТЬ СТРОКУ ОТ КУРСОРА ДО КОНЦА
    Selection.Find.ClearFormatting
    Selection.Find.Font.Color = wdColorAutomatic 'НАЙТИ ТЕКСТ АВТО
With Selection.Find
        .Text = "?"
        .Forward = True
        .MatchWildcards = True
    End With
    Selection.Find.Execute
    Selection.MoveLeft Unit:=wdCell 'ПЕРЕЙТИ НА 1 ЯЧЕЙКУ ВЛЕВО
ActiveDocument.Bookmarks.Add Range:=Selection.Range, Name:="bm2" 'МАРКИРОВАТЬ 2-Ю ЯЧЕКУ С КРАСНЫМ ТЕКСТОМ В СТРОКЕ
Dim arange As Range
Set arange = ActiveDocument.Range( _
Start:=ActiveDocument.Bookmarks("bm1").Range.Start, _
End:=ActiveDocument.Bookmarks("bm2").Range.End)
arange.Select 'ВЫДЕЛИТЬ ДИАПАЗОН С КРАСНЫМ ТЕКСТОМ В СТРОКЕ
Selection.SelectColumn 'ВЫДЕЛИТЬ СООТВЕСТВУЮЩИЕ СТОЛБЦЫ
Selection.Font.Color = wdColorAutomatic 'СДЕЛАТЬ ЦВЕТ ТЕКСТА В ВЫДЕЛЕННЫХ СТОЛБЦАХ АВТО
Selection.InsertColumnsRight 'ВСТАВИТЬ ПУСТЫЕ СТОЛБЦЫ СПРАВА
Selection.Font.Color = wdColorAutomatic 'СДЕЛАТЬ ЦВЕТ ТЕКСТА ВО ВСТАВЛЕННЫХ СТОЛБЦАХ АВТО (Т.К. ВСТАВЛЕННЫЕ СТОЛБЦЫ ПОЧЕМУ-ТО НАСЛЕДУЮТ ФОРМАТ НЕ ЛЕВЫХ СТОЛБЦОВ, А ПРАВЫХ, КОТОРЫЕ М.Б. КРАСНЫМИ И ТОГДА БУДЕТ БЕСКОНЕЧНАЯ ВСТАВКА СТОЛБЦОВ!)
Selection.Columns.Shading.BackgroundPatternColor = wdColorLightTurquoise 'СДЕЛАТЬ ЦВЕТ ЗАЛИВКИ ВО ВСТАВЛЕННЫХ СТОЛБЦАХ ГОЛУБЫМ - ДЛЯ НАГЛЯДНОСТИ, МОЖНО ЗАКОММЕНТИРОВАТЬ
ActiveDocument.Bookmarks("bm1").Delete 'УДАЛИТЬ ЗАКЛАДКИ
ActiveDocument.Bookmarks("bm2").Delete
DoEvents 'чтооб не подвиснуть
End If
    End With
Loop While FLAG = True
    Selection.EndKey Unit:=wdRow 'ПЕРЕЙТИ В КОНЕЦ СТРОКИ
Selection.Columns.Delete 'УДАЛИТЬ ВСТАВЛЕННЫЙ ВНАЧАЛЕ ДОПОЛНИТЕЛЬНЫЙ СТОЛБЕЦ СПРАВА
Selection.Tables(1).Select 'ВЫДЕЛИТЬ ТАБЛИЦУ
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "&&&"
        .Replacement.Text = ""
    End With
    Selection.Find.Execute Replace:=wdReplaceAll 'УДАЛИТЬ ВСТАВЛЕННЫЙ ВНАЧАЛЕ В ПУСТЫЕ ЯЧЕЙКИ ТЕКСТ "&&&"
Selection.Tables(1).AutoFitBehavior (wdAutoFitWindow) 'ВЫРОВНЯТЬ ТАБЛИЦУ ПО ШИРИНЕ ЭКРАНА (СЪЕЗЖАЕТ!)
Application.ScreenUpdating = True
End Sub