Создание цикла переноса данных из одного диапозона в другой

[Freerider1972]

Добрый день!
Помогите создать цикл переноса данных из одних ячеек в другие, образец во вложении
Из желтых ячеек, перенести на зеленые
Строк много, можно использовать для каждой строки, например
[C2:R2].Cut Destination:=[R1]
[C4:R4].Cut Destination:=[R3]
....
строк около 2000, код получится длинный
Подскажите как сделать цикл?

[Hugo121]

Вам нужно перенести именно ячейки со всем форматом, или достаточно перенести только значения?
Второй вариант можно сделать быстро на массиве - берём весь диапазон в массив, в цикле перекладываем данные внутри массива, выгружаем результат назад. Быстро.
Но повозиться с описанием перекладки нужно.

Хотя что там, вот. Только с диапазонами сами подправьте - iLastrow или Inputbox или сразу в коде пропишите или ещё как...

Option Explicit

Sub tt()
Dim a, i As Long, ii As Byte

a = [c1:ag12]
For i = 2 To UBound(a) Step 2
For ii = 1 To 15
a(i - 1, ii + 15) = a(i, ii): a(i, ii) = ""
Next ii, i
[c1:ag12] = a

End Sub

[EugeneS]

есть еще варианты переноса формулами, но значения слева необходимо будет удалять вручную

[Freerider1972]

Hugo121;646052]Вам нужно перенести именно ячейки со всем форматом, или достаточно перенести только значения?

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

[Freerider1972]

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

есть еще варианты переноса формулами, но значения слева необходимо будет удалять вручную

а с формулами какими? волшебными? или просто = такой то ячейке?

[Freerider1972]

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

Вам нужно перенести именно ячейки со всем форматом, или достаточно перенести только значения?
Второй вариант можно сделать быстро на массиве - берём весь диапазон в массив, в цикле перекладываем данные внутри массива, выгружаем результат назад. Быстро.
Но повозиться с описанием перекладки нужно.

Хотя что там, вот. Только с диапазонами сами подправьте - iLastrow или Inputbox или сразу в коде пропишите или ещё как...

Option Explicit

Sub tt()
Dim a, i As Long, ii As Byte

a = [c1:ag12]
For i = 2 To UBound(a) Step 2
For ii = 1 To 15
a(i - 1, ii + 15) = a(i, ii): a(i, ii) = ""
Next ii, i
[c1:ag12] = a

End Sub

Отлично!!! То что нужно!
Будет время, отблагодарю!

[EugeneS]

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

а с формулами какими? волшебными? или просто = такой то ячейке?

формула в ячейку "R1":

=ЕСЛИ(ОСТАТ(СТРОКА()+1;2)=0;ЕСЛИ(СМЕЩ(C1;1;0;1;1)=0;"";СМЕЩ(C1;1;0;1;1));"")

протяните вправо и вниз

[Freerider1972]

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

формула в ячейку "R1":

=ЕСЛИ(ОСТАТ(СТРОКА()+1;2)=0;ЕСЛИ(СМЕЩ(C1;1;0;1;1)=0;"";СМЕЩ(C1;1;0;1;1));"")

протяните вправо и вниз

Всегда удивляюсь как можно так разбираться в формулах!!!
СУПЕР!!!
Спасибо большущее и за формулу!!!