Удаление пустых столбцов в таблице

[umka777_89]

Помогите с макросом, пожалуйста.
Нужно удалить столбцы в таблице (пустые: Семестр1, Семестр2 и тд), пример во вложении.

[Скрипт]

umka777_89, нужно удалить именно столбцы, у которых заголовок содержит слово "Семестр" или заголовок может быть любой и нужно удалить любой пустой столбец?

[umka777_89]

Скрипт, мне именно для данной таблицы, здесь нужно будет удалять только столбцы с незаполненными ячейками, например может быть так
и надо удалить те, что не заполнены

[Скрипт]

umka777_89, я в сообщении #2 задал вопрос и так и не получил на него ответа. Поэтому не могу вам помочь.

[umka777_89]

Скрипт, заголовок содержит слово "Семестр", помогите, пожалуйчта

[Скрипт]

Код работает, если нет объединённых ячеек в таблице.
Код работает с таблицей, в которой находится курсор.

Для ускорения работы кода можно попробовать перейти в режим "Черновик" (Word 2010) и отключить проверку правописания.

Sub Procedure_1()
    
    
    '1. Помещаем в константу "myHeader" фрагмент заголовка
        'столбцов, которые нас интересуют.
    Const myHeader As String = "Семестр"

    Dim myTable As Word.Table
    Dim myLen As Long
    Dim i As Long, j As Long
    
    
    '2. Даём таблице, в которой находится курсор, VBA-имя "myTable".
    'Через это имя будем обращаться к этой таблице. Так удобнее писать код.
    Set myTable = Selection.Tables(1)
    
    
    '3. Берём в переменную "myLen" количество символов,
        'которое во фрагменте заголовка, чтобы каждый раз
        'не вызывать функцию "Len" (может это ускорит работу кода).
    myLen = Len(myHeader)
    
    
    'В цикле с "i" двигаемся по ячейкам первой строки таблицы.
    'Когда что-то удаляем, то удобнее писать код, если
        'двигаться с конца в начало, т.к. порядковые номера
        'элементов меняются.
    For i = myTable.Columns.Count To 1 Step -1
        'Если в ячейке в начале ячейки есть слово "Семестр",
            'то анализируем остальные ячейки столбца.
        If Left(myTable.Cell(1, i).Range.Text, myLen) = myHeader Then
            
            'В цикле с "j" двигаемся по ячейкам столбца.
            For j = 2 To myTable.Rows.Count Step 1
            
                'В каждой Word-ячейке есть всегда два символа:
                    '1) символ "Конец ячейки" (его видно, если включен
                        'режим отображения непечатаемых символов (он круглый));
                    '2) символ, которого вообще не видно никогда.
                'Characters учитывает символ "Конец ячейки".
                'Если в ячейке больше одного символа, значит ячейка не пустая.
                If myTable.Cell(j, i).Range.Characters.Count > 1 Then
                    'Переходим к следующему столбцу.
                    GoTo metka
                End If
                
            Next j
            
            'Если код дошёл до сюда, значит все ячейки
                'в столбце просмотрены и все ячейки пустые.
            'Удаляем столбец.
            myTable.Columns(i).Delete
            
        End If
        
metka:
        
    Next i

End Sub

[umka777_89]

Скрипт, огромное вам спасибо))