Скопируйте определенные столбцы и вставьте вертикально в цикле

Question

Я хочу написать сценарий VBA, который будет выполнять следующее.

Я хотел бы скопировать B3: B7 и C3: C7 и вставить в G2: H6, а затем я хочу получить дату в С2 и вставьте в I3: I7. Затем я хочу повторить это до тех пор, пока он не достигнет пустой колонки, сохраняя B3: B7 и принимая D3: D7, вставляя нижнюю часть в G7: H11 и захватывая дату в D2 и копируя ее в I7: I11.

Я приложил фото с данными и желаемым результатом. Спасибо!

Answer 1

Вот некоторый код VBA, который находит последнюю строку / столбец, использованный в ваших исходных данных, и затем зацикливает это, чтобы произвести вывод, который вы ищете.

Sub sFixData()
    Dim ws As Worksheet
    Dim lngLastCol As Long
    Dim lngLastRow As Long
    Dim lngLoop1 As Long
    Dim lngLoop2 As Long
    Dim lngRow As Long
    Set ws = Sheets("Sheet3")
    lngLastCol = ws.Cells(2, ws.Columns.Count).End(xlToLeft).Column
    lngLastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    lngRow = 3
    For lngLoop1 = 3 To lngLastCol
        For lngLoop2 = 3 To lngLastRow
            ws.Cells(lngRow, 7) = ws.Cells(lngLoop2, 2)
            ws.Cells(lngRow, 8) = ws.Cells(lngLoop2, lngLoop1)
            ws.Cells(lngRow, 9) = ws.Cells(2, lngLoop1)
            lngRow = lngRow + 1
        Next lngLoop2
    Next lngLoop1
End Sub

С уважением,