Копировать вставить каждые 10 ячеек диапазона * 10 раз в столбец

Question

Я хочу копировать и вставлять каждые 10 строк, 10 раз из столбца A в столбец B и так далее до конца столбца A.

Это пример макроса, который я пробовал:

Sub cpydble()
Dim j As Long
Dim i As Long
Dim lRow As Long


lRow = Cells(Rows.Count, 1).End(xlUp).row


For i = 1 To lRow Step 10
    For j = 1 To 100 Step 10
    Cells(i, 1).Resize(10).Copy Destination:=Cells(j, 2)

    Next j
Next i
End Sub

Я новичок в VBA и надеюсь, что вы можете помочь с этим - заранее спасибо.

Это мой текущий результат:

Answer 1

Запуск j в 1 каждый раз, вероятно, что портит. Просто найдите следующую открытую ячейку для каждой петли.

Sub cpydbl()

    Dim i As Long, j As Long
    Dim lRow As Long

    lRow = Cells(Rows.Count, 1).End(xlUp).Row

    For i = 1 To lRow Step 10
        For j = 1 To 10
            Cells(i, 1).Resize(10).Copy Cells(Rows.Count, 2).End(xlUp).Offset(1, 0)
        Next j
    Next i

    Cells(1, 2).Delete xlShiftUp

End Sub

Offset начинает копирование со строки 2, поэтому я удаляю пустую первую ячейку в конце, чтобы переместить все вверх.

Answer 2

Полностью гибкий код

В дополнение к тонкому коду @DickKusleika, я демонстрирую полностью гибкий подход с использованием массива данных, в котором вы можете определить альтернативный размер блока, количество повторений иначать ряд с помощью констант.

Option Explicit                                    ' declaration head of your code module

Sub copyBlocks()
Const SIZE& = 10, REPETITIONS& = 10, STARTROW& = 1 ' define block size, repetions and start row
Dim ws As Worksheet, i&, j&, k&, n&, v             ' declare variables
Set ws = ThisWorkbook.Worksheets("MySheet")        ' << change to your sheet name
n = ws.Range("A" & ws.Rows.Count).End(xlUp).Row    ' find last row number in column A
n = ((n + SIZE) \ SIZE) * SIZE                     ' round up to full block size of 10 rows
ws.Range("B:B") = ""                               ' clear column B
k = STARTROW                                       ' start row of 1st block series
For i = STARTROW To n Step SIZE                    ' if STARTROW = 1 For i=1, 11, 21, 31 ... To n
    v = ws.Range("A" & i).Resize(SIZE)             ' get next data block (10 rows)
    For j = 1 To REPETITIONS                       ' write eg. 10 data blocks to column B
        ws.Range("B" & (k + (j - 1) * SIZE)).Resize(SIZE) = v
    Next j
    k = k + SIZE * REPETITIONS                     ' get start row of next block series
Next i
End Sub

Примечания

• Объявите свои переменные (и их типы) и заставьте себя сделать это, указав Option Explicit в заголовке объявления вашегокодовый модуль;знак амперсанда & означает, например, Dim i As Long.v и все явно не объявленные переменные по умолчанию имеют значение Variant.
• Всегда использовать полные ссылки на диапазон, в противном случае значения по умолчанию относятся к активному листу, что может привести к неправильным значениям.
• Переменная n находит последний номер строки в столбце A и округляет его до полного размера блока, равного 10 строкам.
• Вы можете легко назначить значения диапазона для варианта двумерного массива в одномстрока кода, например, через v = ws.Range("A1:E1234") или v = ws.Range("A1:A17").Value. Дополнительная подсказка Каждый член этого массива может быть адресован индексами строк и столбцов.Обратите внимание, что массивы полей данных, получающие значения из диапазонов рабочего листа, на основе , поэтому первое значение будет адресовано как v(1,1).

Answer 3

Вы можете использовать:

For i = 1 To lRow Step 10
    Range("B" & i & ":B" & i + 9).Value = Range("A1:A10").Value
Next i

Обратите внимание, что в приведенном выше коде последняя итерация пойдет ниже последней строки в столбце A, если она не кратна 10.