как можно увеличить скорость выполнения

[VITA11111]

СПАСИБО ОГРОМНОЕ ВСЕ РАБОТАЕТ
МОЖЕТЕ ПОМОЧЬ СО СКРЫТИЕМ СТОЛБЦОВ ТОЖЕ РАБОТАЕТ МЕДЛЕННО ИЛИ МОЖНО ИСПОЛЬЗОВАТЬ ВАШ ПОСТ №6,8 ?
НА ЛИСТЕ "РАБОЧИЙ ПЛАН" ЕСТЬ ДИАПАЗОН ЯЧЕЕК "J12:BFM12",В КОТОРЫХ СОДЕРЖАТСЯ ФОРМУЛЫ И ЕСЛИ ЯЧЕЙКА РАВНА 0 ТО СКРЫТЬ СТОЛБЕЦ
ЯЧЕЙКИ НЕ ОБЪЕДЕНЕНЫ

[SAS888]

См. вложение.

[VITA11111]

не получается [J12:BFM12] содержат ссылки на значения в других таблицах кажется поэтому не скрывается

Sub qq()
    Dim x As Range, y As Range, z As Range: Application.ScreenUpdating = False
    Set x = [J12:BFM12]: x.EntireColumn.Hidden = False: Set z = x.Find(0)
    If z Is Nothing Then Exit Sub
    Set y = x.RowDifferences(z)
    x.EntireColumn.Hidden = True: y.EntireColumn.Hidden = False
End Sub

попробую разобратся функция address

[VITA11111]

вроде получилось проверте пожалуйста

Sub скрытие_столб_Click()
    Dim x As Range, y As Range, z As Range, fst As String: Application.ScreenUpdating = False
    With Sheets("рабочий план")
    Set x = [J12:BFM12]
    End With
    x.EntireColumn.Hidden = False: Set z = x.Find(0, , xlValues, xlWhole)
    If Not z Is Nothing Then
    fst = z.Address
    Do
        If y Is Nothing Then Set y = z Else Set y = Union(y, z)
            Set z = x.FindNext(z)
            Loop While fst <> z.Address
        End If
    If Not y Is Nothing Then y.EntireColumn.Hidden = True
End Sub

[SAS888]

Все верно. Код рабочий... Только пропущена точка в конструкции With... End With. В данном случае ссылка применяется всего 1 раз. Поэтому, можно просто записать

Set x = Sheets("рабочий план").[J12:BFM12]

Зачем Вы прикрепляете файл, который не соответствует действительности. В Вашем файле в диапазоне "J12:BFM12" нет ссылок. Поэтому я и предложил более быстродействующий вариант, который работоспособен только с значениями.
В данной задаче столбцов для скрытия значительно больше, чем тех, которые скрывать не нужно. Поэтому, быстрее будет работать следующий код:

Sub qq()
    Dim x As Range, y As Range, i As Long, a(): Application.ScreenUpdating = False
    Set x = Sheets("рабочий план").[J12:BFM12]: x.EntireColumn.Hidden = False: a = x.Value
    For i = 1 To UBound(a, 2)
        If a(1, i) = 0 Then If y Is Nothing Then Set y = Cells(12, i + 9) Else Set y = Union(y, Cells(12, i + 9))
    Next
    If Not y Is Nothing Then y.EntireColumn.Hidden = True
End Sub

Пример во вложении.

[VITA11111]

спасибо все работает быстрее