Excel宏脚本，它在excel 2013中的当前行下复制每行20次

Question

我试图复制excel电子表格中的每一行20次...手动执行此操作，638个条目需要很长时间才能完成。

我尝试编写脚本 - 这会给我以下结果（请查找我正在寻找的手册示例）

有人可以解释一下这段代码：

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

这样的事情应该使它相对容易和快速

Sub AddCols()
    Dim howMany As Integer: howMany = Application.InputBox(prompt:="Enter number of rows to add", title:="Bulk Add Rows", type:=1)
    Dim prods As New Collection
    Dim lrow As Long: lrow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row

    Application.ScreenUpdating = False

    Dim tRange As Range
    For Each tRange In ActiveSheet.Range("A2:A" & lrow)
        'Add pointer to cell address-this way it'll adapt while we insert rows
        If Len(tRange.Value) > 0 Then prods.Add tRange
    Next
    Set tRange = Nothing

    Dim prod As Variant
    For Each prod In prods
        ActiveSheet.Range(prod.Address).EntireRow.Resize(howMany).Insert
    Next prod
    Set prod = Nothing

    ActiveSheet.Range("A2:M" & ActiveSheet.UsedRange.Rows.Count).SpecialCells(xlCellTypeBlanks).Select

    For Each prod In Selection
        prod.Value = prod.Offset(-1).Value
    Next

    Application.ScreenUpdating = True
End Sub