Форум по VBA и MS Office

Sub Удалить_пустые_абзацы()

    Dim tbl As Table, cel As Cell, i As Long
   
   
    '1. Отключение монитора.
    Application.ScreenUpdating = False
   
    '2. Vba-именование таблицы, в которой находится текстовый курсор.
    Set tbl = Selection.Tables(1)
   
    '3. Цикл по всем ячейкам таблицы.
    For Each cel In tbl.Range.Cells
   
        ' Цикл по всем абзцам (от последнего к первому) ячейки.
            ' Один первый абзац в ячейке всегда будет и его нельзя удалить,
            ' поэтому просматриваются все абзацы кроме первого.
        For i = cel.Range.Paragraphs.Count To 2 Step -1
       
            ' Просмотр, что находится в абзаце.
            Select Case cel.Range.Paragraphs(i).Range.Text
                ' Если абзац пустой.
                Case Chr(13) & Chr(7)
                    ' Удаление в вышестоящем абзаце на конце символа абзаца.
                    cel.Range.Paragraphs(i).Previous.Range.Characters.Last.Delete
                ' Если в абзаце есть символ табуляции.
                Case Chr(9) & Chr(13) & Chr(7)
                    ' Удаление символа табуляции.
                    cel.Range.Paragraphs(i).Range.Characters(1).Delete
                    ' Удаление в вышестоящем абзаце на конце символа абзаца.
                    cel.Range.Paragraphs(i).Previous.Range.Characters.Last.Delete
                ' Если в абзаце текст, то переход к следующей ячейке.
                Case Else
                    Exit For
            End Select
           
        Next i
    Next cel
   
    '4. Включение монитора.
    Application.ScreenUpdating = True
   
    '5. Сообщение.
    MsgBox "Готово.", vbInformation

End Sub