Copy selected rows twice

Question

I've written a really rudimentary Excel macro to copy the selected row twice, then move the cursor down 3 rows so the process can be repeated again.

So if I have a file where the first 10 rows all need to be repeated twice, I run the macro 10 times.

This already saves me a bunch of keystrokes, but I'm sure it could be written better so I simply select the first 10 rows and then run the macro once.

Here's what I have so far:

Sub Copy_Twice()
' Copies current row twice

    ActiveCell.EntireRow.Select
    Selection.Copy
    Selection.Insert Shift:=xlDown
    ActiveCell.EntireRow.Select
    Selection.Copy
    Selection.Insert Shift:=xlDown
    ActiveCell.Offset(rowOffset:=3).Select

End Sub

For every file I run this macro, it may not be the first 10 rows to be copied.

In fact an even better macro would be to copy every row twice if the cell in Column J is blank.

Update: File has a header row with values for columns A to X. The rows to be copied will be the first x # of rows after the header where column J is blank. So in one example, rows 2-11 need to be duplicated twice. But in another file, it may be rows 2-21.

Answer 1

Can I play too? :P

Here is the fastest way to do it. Let's say your data is from cell A1:A10. Simply run this code.

You don't have to use Copy/Paste at all.

What this code does is, inserts the blank rows and then simulates the Ctrl + G --> Special --> Blank Cells --> Fill blank cell with data from the above row using CTRL + ENTER.

For i = 10 To 2 Step -1
    Rows(i).Insert: Rows(i).Insert
Next i

'~~> After the blank rows are inserted your range will
'~~> expand up to row 30
Range("A1:A30").SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
Range("A1:A30").Value = Range("A1:A30").Value '<~~ Convert formuals back to values

Answer 2

try this:

Dim n&, x&
n = 0
x = Application.WorksheetFunction.CountIf(Range("J:J"), " ")
Range("A2").Select

While n <> x
    ActiveCell.EntireRow.Copy: ActiveCell.Offset(1, 0).EntireRow.Insert
    ActiveCell.EntireRow.Copy: ActiveCell.Offset(1, 0).EntireRow.Insert
    ActiveCell.Offset(3, 0).Select
    n = n + 1
Wend
Application.CutCopyMode = False
End Sub