Выделение листов по списку

[Hugo121]

Берёте названия в коллекцию (ну или считаете количество), объявляете такой массив, набиваете его именами/названиями, используете.
Например:

Sub tt()
    Dim col As New Collection, c As Range, i&
    For Each c In [a1].CurrentRegion.Cells
        col.Add Trim(c)
    Next
    ReDim arr(0 To col.Count - 1)
    For i = 1 To col.Count: arr(i - 1) = col(i): Next
    Worksheets(arr).Select
End Sub

[autostavrroute]

Private Sub Кнопка37_Щелчок()

Dim Lar As Variant
Lar = Sheets("График").Range("D5")
Sheets(Lar).Select
End Sub

Так работает но для одной ячейки и выделяет одноименный лист. Как правильно описать если
Lar = Sheets("График").Range("D5:F5")

[IgorGO]

Lar = Sheets("График").Range("D5:D8").Val ue

[autostavrroute]

Сообщение от IgorGO

Lar = Sheets("График").Range("D5:D8").Val ue

Я так понимаю тут нужен алгоритм переобъявления массива ReDim Lar - но что-то я не соберу все в кучу.

[autostavrroute]

Сообщение от Hugo121

Берёте названия в коллекцию (ну или считаете количество), объявляете такой массив, набиваете его именами/названиями, используете.
Например:

Sub tt()
    Dim col As New Collection, c As Range, i&
    For Each c In [a1].CurrentRegion.Cells
        col.Add Trim(c)
    Next
    ReDim arr(0 To col.Count - 1)
    For i = 1 To col.Count: arr(i - 1) = col(i): Next
    Worksheets(arr).Select
End Sub

Наверно написано то что надо, но не могу связать со своим примером и привязкой к ячейкам на листе График где перечислены названия листов которые надо выделить одновременно.

[Serge_Bliznykov]

Сообщение от autostavrroute

Наверно написано то что надо, но не могу связать со своим примером и привязкой к ячейкам на листе График

так:

Sub SelectSheetsByRange()
 Dim col As New Collection, c As Range, i&
 For Each c In Sheets("График").Range("D5:F5").Cells
        col.Add Trim(c)
 Next
 ReDim arr(0 To col.Count - 1)
 For i = 1 To col.Count: arr(i - 1) = col(i): Next
 Worksheets(arr).Select
End Sub

[autostavrroute]

Sub SelectSheetsByRange()
 Dim col As New Collection, c As Range, i&, k&
 
 For k = 4 To 17
 If Not Sheets("График").Cells(5, k).Value = "" Then coll.Add Sheets(k).Name
 Next
 
' For Each c In Sheets("График").Range("D5:Z5").Cells
'        col.Add Trim(c)
' Next

 ReDim arr(0 To col.Count - 1)
 For i = 1 To col.Count: arr(i - 1) = col(i): Next
 Worksheets(arr).Select
  
End Sub

Хотел модифицировать на обработку ячеек с пробелами. Но что-то написал не верно.

Предыдущий вариант работает на УРА.


_____
Код программы нужно выделять (форматировать) тегами [CODE] (читать FAQ)
Модератор

[autostavrroute]

Сообщение от autostavrroute

ячеек с пробелами

Точнее сказать "Пустых ячеек" Если не трудно исправьте ошибку.

Сообщение от autostavrroute

For k = 4 To 17
If Not Sheets("График").Cells(5, k).Value = "" Then coll.Add Sheets(k).Name
Next

Несколько не ладится в этой части макроса.

[Aleksandr H.]

If Sheets("График").Cells(5, k).Value <> "" Then coll.Add Sheets(k).Name

[offtop]2 страницы трепа, а можно было в 1ом сообщении приклеить файла с тестовыми данным, написать "Вот файл, вот список страниц, хочу нажать кнопку и чтоб листы со списка выделились". Я бы предложил их удалить, а дальше коллеги бы наваяли рабочий код. Итого макс на 5 сообщении был бы получен ответ. Но то такое, лирика. [/offtop]

[autostavrroute]

Оператор Not там стоит верно - он проверяет если ячейка не пустая тогда добавляет ее в массив. Ошибка где то рядом)