Вырезать и вставить со смещением динамического диапазона, который зависит от активной строки

Question

Действительно новичок в VBA, так что простите за любые глупости, которые я говорю / делаю. Этот сайт очень помог мне в ускоренном обучении.

У меня есть набор данных в Excel, который мне нужно переставить с помощью VBA. Я хочу взять (вырезать) данные из столбцов AF: AR для строки и переместить (вставить) их в столбцы J: V в новой строке, вставленной под исходной. Каждый раз, когда я запускаю отчет, размер данных различается, поэтому я подхожу к нему с конца набора данных и перемещаюсь вверх по электронной таблице. У набора данных есть заголовки, поэтому он останавливается на строке 2. До сих пор я планирую перейти к концу набора данных, вырезать данные из последней строки и вставить их в строку ниже, вставить пустую строку выше, затемдвигайтесь вверх по ряду и повторяйте, пока строка 2 не будет достигнута.

Вот что у меня есть:

' Move to end of data.
Selection.End(xlDown).Select
' Repeat loop until top of data is reached..
Do Until ActiveCell.Row = 2
    ' Get row address of active cell.
    ActiveRow = ActiveCell.Row
    ' Cut and paste data to row below current row.
    Range(Cells(ActiveRow, "AF"), Cells(ActiveRow, "AR")).Cut Range("J" & ActiveRow).Offset(1, 0)
    ' Insert a blank row above.
    ActiveCell.Offset(-1, 0).Select
    ActiveCell.EntireRow.Insert Shift:=xlDown
    ' Move to next row of data up.
    ActiveCell.Offset(-1, 0).Select
Loop

Во время работы я получаю эту ошибку

"Ошибка времени выполнения" 1004 ": определяется приложением или объект-Ошибка: "

и отладка указывает на следующую строку:

Range(Cells(ActiveRow, "AF"), Cells(ActiveRow, "AR")).Cut Range("J" & ActiveRow).Offset(1, 0)

Не могу найти никакой информации об использовании динамического диапазона со смещением в.Cut функция, так что это может быть проблемой. Что-то не так / отсутствует в моем синтаксисе или есть более простой способ достижения моей цели?

Заранее благодарим за то, что поделились своим гением.

Answer 1

Это немного чище и намного быстрее, но все еще имеет шипы выбора и активации. Я могу вернуться и поработать над этим в будущем, но пока это работает.

'Define the range of remaining data.
Set rngData = ThisWorkbook.Worksheets("Sheet2").Range("A1")
Set rngData = rngData.CurrentRegion

' Move to end of data.
rngData.End(xlDown).Select
Do Until ActiveCell.Row = 1
    ' Get row address of active cell.
    ActiveRow = ActiveCell.Row
    ' Cut and paste OCC data to row below current row.
    Range(Cells(ActiveRow, "AF"), Cells(ActiveRow, "AR")).Cut Range("J" & (ActiveRow + 1))
    ' Insert a blank row above.
    ActiveCell.EntireRow.Insert Shift:=xlDown
    Selection.Offset(-1, 0).Select
' Repeat until top of data is reached.
Loop

' Delete unnecessary remaining column headers.
ThisWorkbook.Worksheets("Sheet2").Range("AF1:AR1").Clear

' Delete Unnecessary blank row #2.
Range("A2").EntireRow.Delete

Answer 2

Спасибо SJR за указание на проблему!

Я добавил дополнительное смещение перед циклом, чтобы двигаться вверх от нижней части листа. Это (наряду с несколькими другими небольшими правками) работает, но неэффективно вообще . Врезка и вставка пустых ячеек в более чем 1 млн строк таблицы занимает массу времени. Я буду работать над дополнительным решением, которое устраняет выбор и регулирует диапазон так, чтобы он включал только область, где присутствуют данные.

Selection.End(xlDown).Select
    ActiveCell.Offset(-1, 0).Select
    Do Until ActiveCell.Row = 3
        ' Get row address of active cell.
        ActiveRow = ActiveCell.Row - 1
        ' Cut and paste OCC data to row below current row.
        Range(Cells(ActiveRow, "AF"), Cells(ActiveRow, "AR")).Cut Range("J" & (ActiveCell.Row))
        ' Insert a blank row above.
        ActiveCell.Offset(-1, 0).Select
        ActiveCell.EntireRow.Insert Shift:=xlDown
    ' Repeat until top of data is reached.
    Loop