Im trying to create an excel macro to select a range of cells then insert new row every other row then copy and paste each row.

For example.

My desired goal is

I have thousands of rows and a macro would be nice.

This Inserts a new row,every other row.

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

How can I duplicate the lines in the range too?

CodePudding user response：

Not inserting rows, this code copies and pastes each value twice. Inserting rows is really time consuming.

Here's a screenshot of before/after running code:

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

CodePudding user response：

I recommend to read the values into an array and duplicate them into another array and finally write that array to the cells. This is much faster than duplicating cells.

Option Explicit

Public Sub DuplicateSelectedRows()
    Dim SelRng As Range
    Set SelRng = Selection
    
    ' read values into array
    Dim SelectedValues As Variant
    SelectedValues = SelRng.Value
    
    ' create output array of double the size
    Dim DuplicatedValues As Variant
    ReDim DuplicatedValues(1 To UBound(SelectedValues, 1) * 2, 1 To UBound(SelectedValues, 2))
    
    ' duplicate values
    Dim iRow As Long
    For iRow = 1 To UBound(SelectedValues, 1)
        DuplicatedValues(iRow * 2 - 1, 1) = SelectedValues(iRow, 1)
        DuplicatedValues(iRow * 2, 1) = SelectedValues(iRow, 1)
    Next iRow
    
    ' output values
    SelRng.Cells(1, 1).Resize(RowSize:=UBound(DuplicatedValues)).Value = DuplicatedValues
End Sub