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

Question

Какие изменения мне нужно сделать в приведенном ниже коде, чтобы вся строка была скопирована в определенное количество строк, а не только в первый столбец?

Sub InsertSessions()
Dim Rng As Long
Dim k As Long
Dim rRange As Range

Set rRange = Selection

ActiveCell.EntireRow.Select

Rng = InputBox("Enter number of sessions:.")
For k = 1 To Rng
Rows(rRange.Row).Insert Shift:=xlDown, _
           CopyOrigin:=xlFormatFromLeftOrAbove
Call rRange.Copy(Range(Cells(rRange.Row - 1, rRange.Column), Cells(rRange.Row - 1, rRange.Column)))


Next k
End Sub

Answer 1

это должно работать без необходимости l oop:

Option Explicit
Sub InsertSessions()

    Dim rRange As Range
    Set rRange = Selection.EntireRow

    Dim Rng As Long
    Rng = InputBox("Enter number of sessions:.") * rRange.Rows.Count

    With ActiveSheet
        Dim StartRng As Range
        Set StartRng = .Cells(rRange.Cells(rRange.Rows.Count, 1).Offset(1), 1)

        StartRng.Resize(Rng).Insert xlDown
        rRange.Copy .Range(.Cells(StartRng, 1), .Cells(StartRng.Offset(Rng - 1), 1))
    End With

End Sub