Копирование диапазона

[Kvint_Sertoriy]

Добрый день.

Я пытался написать простой макрос, но у меня, к сожалению, не вышло.

Задача следующая:

Имеется диапазон данных [3;8]. Необходимо его вырезать по сегментам слева направо и расположить сегменты один под другим. Каждый сегмент имеет размер [3;2], так что в итоге должен получиться диапазон размером [12;2].

Я попытался написать макрос, используя Cells и переменные, так как для меня важно каждый раз легко менять размерности диапазонов. Но макрос сработал некорректно из-за того, что счётчики работают не параллельно.

Подскажите, пожалуйста, в чём я ошибся и как можно выполнить мою задачу.

Заранее большое спасибо.

Код и файл прилагаю.

Код:
Sub Перестановка()

Application.ScreenUpdating = False

Dim i As Integer
Dim j As Integer

For j = 3 To 7 Step 2
For i = 5 To 11 Step 3

With ActiveSheet.Range(Cells(2, j), Cells(4, j + 1)).Cut
Range(Cells(i, 1), Cells(i + 3, 2)).Select
ActiveSheet.Paste

End With
Next i
Next j

End Sub

[EducatedFool]

А зачем макрос?
Простейшие формулы не подойдут?
http://excelvba.ru/XL_Files/Sample__...2__3-13-09.zip

[Kvint_Sertoriy]

Спасибо за вариант, но я думаю формулы не хватит. Я выслал упрощенный пример. В реальности размеры будут гораздо больше, по этому хотелось бы макрос, он, всё-таки, универсальнее.

Плюс, хотелось бы узнать в чём я ошибся? Нет ли какого-то способа для параллельной работы счётчиков в структуре For... Next ?

[Казанский]

Достаточно одного цикла

Sub Перестановка()
Dim i&

For i = 2 To 4
    Cells(2, i * 2 - 1).Resize(3, 2).Cut Cells(i * 3 - 1, 1)
Next
End Sub

[Kvint_Sertoriy]

Большое спасибо, это то, что мне было нужно.