VBA - выделение группы листов

[Tihon]

В книге три листа: "010910р", "020910р", "030910р".
И есть два варианта.
Первый. Работает.

Sub Автофигура3_Щелкнуть()
' Получить список листов для перемещения
  GroupName = Array("010910р", "020910р", "030910р")
  Sheets(GroupName).Select
End Sub

Второй. Не работает.
В книге те же три листа: "010910р", "020910р", "030910р".

Sub Автофигура3_Щелкнуть()
' Получить список листов для перемещения
  Dim GroupName As Variant
  ReDim GroupName(0)
  For twhb = 1 To 1 'ThisWorkbook.Sheets.Count
     If Right(Sheets(twhb).Name, 1) = "р" Then
         GroupName(twhb - 1) = Sheets(twhb).Name
         ReDim Preserve GroupName(twhb)
     End If
  Next twhb
  ReDim Preserve GroupName(twhb - 1)
  Sheets(GroupName).Select
End Sub

От последней строки получаю : Subscript out of range (Error 9)
В чем дело, граждане?! Разве это не одно и то же?
Спасибо.

[EducatedFool]

Sub Автофигура3_Щелкнуть()    ' Получить список листов для перемещения
    ReDim GroupName(1 To 1)
    For twhb = 1 To ThisWorkbook.Sheets.Count
        If Right(Sheets(twhb).Name, 1) = "р" Then
            n = n + 1: ReDim Preserve GroupName(1 To n)
            GroupName(n) = Sheets(twhb).Name
        End If
    Next twhb
    Sheets(GroupName).Select
End Sub

Sub Вариант2() ' Получить список листов для перемещения
    Dim sh As Worksheet: ReDim GroupName(1 To 1)
    For Each sh In ThisWorkbook.Worksheets
        If sh.Name Like "*р" Then n = n + 1: ReDim Preserve GroupName(1 To n): GroupName(n) = sh.Name
    Next sh
    On Error Resume Next: Sheets(GroupName).Select
End Sub

PS: А зачем вообще выделять листы?
Может, есть решение попроще...

[Tihon]

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

[code]Sub
PS: А зачем вообще выделять листы?
Может, есть решение попроще...

Спасибо. Ваш второй вариант нравится мне больше Вашего первого. Впрочем, и он хорош.
И оба, естественно, работают.
Но все же, извините за занудство, в чем моя ошибка со вторым вариантом?

А про выделение группой - наверное, можно придумать без него. как это сделать, - я не знаю. С благодарностью приму ваш совет.

[EducatedFool]

как это сделать, - я не знаю. С благодарностью приму ваш совет.

Я тоже не знаю, как сделать ЭТО...
Вот если бы вы сказали, что пытаетесь сделать - глядишь, и посоветовал бы что-нибудь.

в чем моя ошибка со вторым вариантом?

Фиг знает))) что-то вы там сильно напутали с изменениями размеров массива.
Я не смог разобраться - поэтому переписал код заполнения массива "с нуля"

[IgorGO]

у Вас 3 листа, а в массиве GroupName(3) - 4 элемента. GroupName(0) у Вас не заполнен - там и ошибка

[Tihon]

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

Я тоже не знаю, как сделать ЭТО...
Вот если бы вы сказали, что пытаетесь сделать - глядишь, и посоветовал бы что-нибудь.

Пока что ноги растут из такого вот места )))
Из книги с расчетами за текущий месяц надо сделать книгу за следующий. Для этого все листы к расчетами за каждый день, сгруппировав, уберем в новую книгу-архив.
Дальше неинтересно, пока не возникает потребность вернуть из архива рабочие листы за прошлый месяц для пересчета.
На каждом листе есть кнопка с макросом, лежащим в родной расчетной книге. И на листе, перемещенном туда-обратно, ссылка на макрос, присвоенный кнопке, почему-то указывает на "архив", а не на исходную, родную для него расчетную книгу. А в "архиве" его, естественно, нет.
Вот и появилась идея прописать механизм, который при программном перемещении группы листов в "архив"/из "архива" будет контролировать-восстанавливать ссылки на макросы.
Это несложно, на самом деле. Тем более, что Вы мне здорово помогли.

[Tihon]

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

у Вас 3 листа, а в массиве GroupName(3) - 4 элемента. GroupName(0) у Вас не заполнен - там и ошибка

Нет, вы неправы.

Sub Автофигура3_Щелкнуть()
' Получить список листов для перемещения
  Dim GroupName As Variant
  ReDim GroupName(0)
  For twhb = 1 To 3 'ThisWorkbook.Sheets.Count
     If Right(Sheets(twhb).Name, 1) = "р" Then
         GroupName(twhb - 1) = Sheets(twhb).Name
         ReDim Preserve GroupName(twhb)
     End If
  Next twhb
  ReDim Preserve GroupName(twhb - 1)
  Sheets(GroupName).Select
End Sub

(Исправил описку - цикл от 1 до 3!)...
Обратите внимание - в первой итерации имя ПЕРВОГО листа присваивается НУЛЕВОМУ элементу массива Groupname. И отладчик показывает, что в массиве - ТРИ элемента (0-ой, 1-й и 2-й), и что пустых нет.

[IgorGO]

согласен, погарячился, был не прав.
но теперь я не знаю где ошибка и искать Вам ее самому...

[EducatedFool]

Первая ошибка в том, что надо сначала увеличивать размерность массива, и лишь потом добавлять элементы.
Таким образом, надо поменять местами 2 строки:

ReDim Preserve GroupName(twhb)
GroupName(twhb - 1) = Sheets(twhb).Name

Вторая ошибка в том, что не все элементы массива заполняются:

Индекс = 0 Значение = ""
Индекс = 1 Значение = ""
Индекс = 2 Значение = "pЛист6р"
Индекс = 3 Значение = ""
Индекс = 4 Значение = ""
Индекс = 5 Значение = "pЛист3р"
Индекс = 6 Значение = "pЛист2р"
Индекс = 7 Значение = ""
Индекс = 8 Значение = ""

Т.е., даже если имя листа не подходит, массив вы всё равно расширяете (последней строкой кода) до количества листов.
Отсюда - пустые элементы.

Даже если убрать лишнюю строку кода ReDim Preserve GroupName(twhb - 1), это мало что изменит.
(при нахождении следующего подходящего листа размерность массива увеличится не на единицу - а до индекса текущего листа.

Убедитесь сами при помощи такого кода:

Sub Автофигура3_Щелкнуть()    ' Получить список листов для перемещения
    Dim GroupName As Variant
    ReDim GroupName(0)
    For twhb = 1 To ThisWorkbook.Sheets.Count
        If Right(Sheets(twhb).Name, 1) = "р" Then
            ReDim Preserve GroupName(twhb)
            GroupName(twhb - 1) = Sheets(twhb).Name
        End If
    Next twhb
    'ReDim Preserve GroupName(twhb - 1)

    For i = LBound(GroupName) To UBound(GroupName)
        Debug.Print "Индекс = " & i, "Значение = """ & GroupName(i) & """"
    Next i
    'Sheets(GroupName).Select
End Sub

Третья ошибка - что расширять массив надо не с запасом:
вместо ReDim Preserve GroupName(twhb) надо поставить ReDim Preserve GroupName(twhb - 1)

[Tihon]

Спасибо за разбор полетов, уважаемый EducatedFool. Над логикой мне еще работать и работать.
Надеюсь когда-нибудь Вам помогут также быстро и красиво, как Вы помогли мне.
С искренним к Вам Уважением.