excel - 创建新行，然后复制并粘贴行

Question

我试图创建一个 excel 宏来选择一系列单元格，然后每隔一行插入新行，然后复制并粘贴每一行。

例如。

苹果
橘子
芒果

我想要的目标是

苹果
苹果
橘子
橘子
芒果
芒果

我有数千行，一个宏会很好。

这将插入一个新行，每隔一行。

Sub InsertNewRows()
    Dim rng As Range
    Dim CountRow As Integer
    Dim i As Integer
    Set rng = Selection
    CountRow = rng.EntireRow.Count
    
    For i = 1 To CountRow
        ActiveCell.Offset(1, 0).EntireRow.Insert
        ActiveCell.Offset(2, 0).Select
    Next i
End Sub

我怎样才能复制范围内的行呢？

标签： excelvba

Answer 1

不插入行，此代码复制并粘贴每个值两次。插入行真的很耗时。

这是运行代码之前/之后的屏幕截图：

Sub test()
Dim MyData As Variant
Dim LR As Long
Dim i As Long
Dim Initial_Row As Long

LR = Range("A" & Rows.Count).End(xlUp).Row 'last non blank cell in column A

MyData = Range("A1:A" & LR).Value 'all data into array

Initial_Row = 1 'initial row where data starts pasting

For i = 1 To UBound(MyData) Step 1
    Range("A" & Initial_Row & ":A" & Initial_Row + 1).Value = MyData(i, 1)
    Initial_Row = Initial_Row + 2
Next i

Erase MyData 'delete data
End Sub