Excel: удалить все пустые строки и столбцы, если в них нет данных. VBA макрос

Требуется удалить все пустые строки и столбцы на листе Excel, в т.ч. расчерченные границами, с форматами, залитые цветом, скопированные с другого листа и не заполненные и т.д.

Зачем это нужно?

Мне понадобилось для того, чтобы с помощью Power Query свести в одну сводную таблицу 50 однотипных вкладок, в которых МОП несколько лет подряд по месяцам вносили все заказы клиентов. При этом объединение через Power Query работает при условии, что: 

  • у таблиц на всех обрабатываемых листах одинаковая шапка (некоторые листы на выбор можно пропустить); 
  • на листах с исходными таблицами нет лишних данных. На одном листе — одна таблица. 
  • Последняя использованная ячейка листа должна быть последней ячейкой таблицы с данными. Проверка с помощью Ctrl+End. (Вот на этом этапе макрос и понадобился, т.к. МОПы в процессе творчества уходили кто куда, далеко за пределы данных таблицы. А когда в файле одного менеджера 50 вкладок, а менеджеров много, удалять пустые строки/столбцы долго и скучно).

Инструкция по сборке сводной по нескольким диапазонам из разных листов есть у Николая Павлова. Инструкция по сборке сводной одновременно из разных файлов Excel — здесь (пароль 123).


Макрос для отдельного листа Excel

  • Макрос обрабатывает фактически занятый диапазон (UsedRange), а не все строки листа.

  • Отключаются обновления экрана и автовычисления .

  • Безопасно перезапускается даже на большом листе.

  • За счет этого выполнение происходит очень быстро.

				
					Option Explicit

Sub УдалитьПустыеСтрокиИСтолбцы_Быстро()
    Dim ws As Worksheet
    Dim r As Long, c As Long
    Dim lastRow As Long, lastCol As Long
    Dim dummy As Range

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False

    Set ws = ActiveSheet

    ' Определяем последнюю реально занятую строку и столбец
    With ws.UsedRange
        lastRow = .Rows(.Rows.Count).Row
        lastCol = .Columns(.Columns.Count).Column
    End With

    ' Удаляем пустые строки снизу вверх
    For r = lastRow To 1 Step -1
        If Application.WorksheetFunction.CountA(ws.Rows(r)) = 0 Then
            ws.Rows(r).Delete
        End If
    Next r

    ' Удаляем пустые столбцы справа налево
    For c = lastCol To 1 Step -1
        If Application.WorksheetFunction.CountA(ws.Columns(c)) = 0 Then
            ws.Columns(c).Delete
        End If
    Next c

    ' Обновить UsedRange (восстановить правильную позицию Ctrl+End)
    Set dummy = ws.UsedRange

    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

    MsgBox "Пустые строки и столбцы удалены. Область данных обновлена.", vbInformation
End Sub


				
			



Этот же макрос для всех листов книги

  • Обходит все листы, включая скрытые.

  • Пропускает полностью пустые листы.

  • Защищён от сбоев на ‘проблемных’ листах (On Error Resume Next + GoTo NextSheet).

				
					Option Explicit

Sub УдалитьПустыеСтрокиИСтолбцы_НаВсехЛистах()
    Dim ws As Worksheet
    Dim r As Long, c As Long
    Dim lastRow As Long, lastCol As Long
    Dim dummy As Range

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False

    For Each ws In ThisWorkbook.Worksheets
        With ws
            On Error Resume Next ' на случай проблем с пустыми листами

            ' Определяем UsedRange (активный диапазон)
            If Application.WorksheetFunction.CountA(.Cells) = 0 Then GoTo NextSheet ' пропустить полностью пустой лист

            With .UsedRange
                lastRow = .Rows(.Rows.Count).Row
                lastCol = .Columns(.Columns.Count).Column
            End With

            ' Удаляем пустые строки снизу вверх
            For r = lastRow To 1 Step -1
                If Application.WorksheetFunction.CountA(ws.Rows(r)) = 0 Then
                    ws.Rows(r).Delete
                End If
            Next r

            ' Удаляем пустые столбцы справа налево
            For c = lastCol To 1 Step -1
                If Application.WorksheetFunction.CountA(ws.Columns(c)) = 0 Then
                    ws.Columns(c).Delete
                End If
            Next c

            ' Принудительное обновление UsedRange
            Set dummy = .UsedRange

NextSheet:
            On Error GoTo 0
        End With
    Next ws

    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

    MsgBox "Обработка завершена: пустые строки и столбцы удалены на всех листах.", vbInformation
End Sub


				
			

Если что, напомним как добавить макрос и заставить его работать:

1) В Excel, Word, PP и т.д., нажать Alt + F11, или кнопку Visual Basic на вкладке Разработчик. В меню редактора VBA вставить новый модуль Insert — Module

 и вставить в окошко редактора расположенный выше код, далее можно сохранить код, нажав
 Ctrl + S и закрыть окно VBA (Alt + F4);

2) Нажать Alt + F8, выбрать макрос и нажать кнопку Выполнить.

Telegram
VK
Email
Прокрутить вверх