Как создать al oop для копирования и вставки данных с одного рабочего листа на другой

Question

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

Начальные начальные местоположения данных из листа ImportTXT всегда будут одинаковыми (строка 51), а таблица на листе ExtractData всегда должна быть в одном и том же местоположение также, поэтому вставка всегда будет начинаться в "D8: I8". Я хотел бы написать его так, чтобы он работал до тех пор, пока не останется пустых ячеек (так что до конца, независимо от того, сколько строк напряжений и деформаций есть), поскольку длина данных может варьироваться (ссылка на ячейку (т.е. "до строки 122 "не будет; не всегда будет фиксированной суммой).

Повторяющийся код, который у меня есть до сих пор:

Sub CutCopyPasteData()
    Worksheets("ImportTXT").Range("B51:G51").Copy Worksheets("ExtractData").Range("D8:I8")
    Worksheets("ImportTXT").Range("D52:G52").Copy Worksheets("ExtractData").Range("J8:M8")

    Worksheets("ImportTXT").Range("B53:G53").Copy Worksheets("ExtractData").Range("D9:I9")
    Worksheets("ImportTXT").Range("D54:G54").Copy Worksheets("ExtractData").Range("J9:M9")

    Worksheets("ImportTXT").Range("B55:G55").Copy Worksheets("ExtractData").Range("D10:I10")
    Worksheets("ImportTXT").Range("D56:G56").Copy Worksheets("ExtractData").Range("J10:M10")
End Sub

Это только для первых трех строк, однако, как вы можете см. «Bx: Gx» и «Dx: Gx» увеличивается на 2, а «Dx: Ix», а также «Jx: Mx» увеличивается на 1.

Изображение данных в организованной форме:

Изображение вывода таблицы с первыми тремя строками

Если они есть для l oop или до l oop, которые могут динамически обновлять ссылки на ячейки и скопировать все данные, тогда это будет моей целью. Спасибо.

Answer 1

Попробуйте следующее:

Sub CutCopyPasteData()

    Dim rngImp1 As Range, rngImp2 As Range, rngDest As Range

    Set rngImp1 = Worksheets("ImportTXT").Range("B51:G51")
    Set rngImp2 = Worksheets("ImportTXT").Range("D52:G52")
    Set rngDest = Worksheets("ExtractData").Rows(8)

    Do While Application.CountA(rngImp1) > 0

        rngImp1.Copy rngDest.Range("D1") 'the 1 is relative to the row...
        rngImp2.Copy rngDest.Range("J1")

        Set rngImp1 = rngImp1.Offset(2, 0) 'move down 2 rows
        Set rngImp2 = rngImp2.Offset(2, 0)
        Set rngDest = rngDest.Offset(1, 0) 'move down 1 row
    Loop
End Sub