Что нужно изменить или добавить в этом макросе?
Код: Выделить всё
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