Назначение имени скопированным листам

Весь MS Office, программирование на Visual Basic for Applications и MS VB

Модератор: Naeel Maqsudov

Ответить
VanBlack
Сообщения: 69
Зарегистрирован: 26 окт 2013, 15:28

Здравствуйте! После нажатия кнопки "Создать сетки боёв" на листе "Список по группам" (см. вложение) создаются копии определённых листов, в зависимости от количества спортсменов в группе. В эти листы в ячейки "F1" и "J1" так же копируются значения столбцов "N" и "O" листа "Список по группам". Имена созданных листов не меняются, добавляется лишь в скобках номер копии (2 (2); 8 (2); 2 (3)... ну и так далее). А можно ли, чтобы этим листам присваивались имена, состоящие из из тех же значений столбцов "N" и "O" листа "Список по группам"? Например 9-10 до 30 кг, м".
Что нужно изменить или добавить в этом макросе?

Код: Выделить всё

Sub Создать_сетки_поединков()
  Dim Mas, iRow&, cRow&, sRow&, RowList&, i&, tmp!, ShName, GrVes$, GrVozr$
    Mas = Range(Cells(5, 2), Cells(Rows.Count, "O").End(xlUp).Offset(1)).Value
    iRow = 1
    cRow = UBound(Mas)
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    While iRow < cRow
        While iRow < cRow And Mas(iRow, 1) = Empty: iRow = iRow + 1: Wend
        If iRow = cRow Then Exit Sub
        GrVozr = Mas(iRow, 13)
        GrVes = Mas(iRow, 14)
        sRow = iRow
        While iRow < cRow And Mas(iRow, 1) <> Empty: iRow = iRow + 1: Wend
        tmp = iRow - sRow
        i = 0
        While tmp > 1: tmp = tmp / 2: i = i + 1: Wend
        If i < 1 Then i = 1
        RowList = 4
        Sheets(CStr(2 ^ i)).Copy after:=Sheets(Sheets.Count)
        [F1] = GrVozr
        [J1] = GrVes
        For sRow = sRow To iRow - 1
            Cells(RowList, "B") = Mas(sRow, 1)
            Cells(RowList, "C") = Mas(sRow, 5)
            Cells(RowList, "D") = Mas(sRow, 8)
            RowList = RowList + 1
        Next
        iRow = iRow + 1
    Wend
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub
Вложения
1..zip
(87.66 КБ) 34 скачивания
VanBlack
Сообщения: 69
Зарегистрирован: 26 окт 2013, 15:28

Спасибо всем заглянувшим в тему! Проблема решена. Нужно было всего лишь добавить строку
[HTML]ActiveSheet.Name = GrVozr & " " & GrVes[/HTML]
Ответить