Excel VBA - Макрос, который работает для всего диапазона ячеек

Question

У меня есть приведенный ниже макрос, который выполняет транспонирование диапазона ячеек.

Sub Macro45()
'
' Macro45 Macro
' r3
'
' Keyboard Shortcut: Ctrl+e
'
Range("F2:G8").Select
Selection.Copy
Range("H2").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True
End Sub

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

Answer 1

Вот еще одно решение:

Sub main()

    Dim rngSrc As Range
    Set rngSrc = Range("F2:G8")

    While (rngSrc.Cells(1, 1).Value2 <> "")
       transpose rngSrc
       Set rngSrc = rngSrc.Offset(7, 0)
    Wend
End Sub


Sub transpose(rngSrc As Range)

    rngSrc.Copy
    rngSrc.Cells(1, 2).Offset(0, 1).PasteSpecial Paste:=xlPasteAll, _
        Operation:=xlNone, SkipBlanks:=False, transpose:=True

End Sub

Answer 2

Кажется, вы делаете определенные шаги из 7 строк. Поэтому, возможно, попробуйте:

Sub Test()

Dim lr As Long, x As Long

With ThisWorkbook.Worksheets("Sheet1") 'Change accordingly

    'Find last used row
    lr = .Cells(.Rows.Count, 6).End(xlUp).Row

    'Step through data and transpose values
    For x = 2 To lr Step 7
        .Cells(x, 8).Resize(2, 7).Value = Application.Transpose(.Range(.Cells(x, 6), .Cells(x + 6, 7)).Value)
    Next x

End With

End Sub

---

Или, если вас действительно интересуют значения и формат копирования и вставки:

Sub Test()

Dim lr As Long, x As Long

With ThisWorkbook.Worksheets("Sheet1") 'Change accordingly

    'Find last used row
    lr = .Cells(.Rows.Count, 6).End(xlUp).Row

    'Step through data
    For x = 2 To lr Step 7
        .Range(.Cells(x, 6), .Cells(x + 6, 7)).Copy
        .Cells(x, 8).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    Next x

End With

End Sub