В первом приближении макрос
Код |
---|
Sub Tablica()
Dim i As Long
Dim j As Integer
Dim iLastRow As Long
Dim iCol As Integer 'количество необходимых столбцов
Dim k As Integer 'кол-во столбцов с Range("P6")
iLastRow = Cells(Rows.Count, "O").End(xlUp).Row
iCol = WorksheetFunction.RoundUp((iLastRow - 5) / Range("P6"), 0)
Range(Cells(4, 1), Cells(3 + Range("P6"), iCol)).ClearContents
k = 0
Do
k = k + 1
Loop While k * Range("P6") + (iCol - k) * (Range("P6") - 1) <> iLastRow - 5 Or k > iCol - 1
j = 1
For i = 6 To k * Range("P6") + 5 Step Range("P6")
Range(Cells(i, "O"), Cells(i + Range("P6") - 1, "O")).Copy Cells(4, j)
j = j + 1
Next
For i = k * Range("P6") + 6 To iLastRow - 5 Step Range("P6") - 1
Range(Cells(i, "O"), Cells(i + Range("P6") - 2, "O")).Copy Cells(4, j)
j = j + 1
Next
End Sub
|