Copy selected rows twice

Question

I wrote a truly rudimentary Excel macro to copy the selected row twice, then move the cursor down 3 rows to repeat the process again.

So, if I have a file in which the first 10 lines need to be repeated twice, I run the macro 10 times.

This will save me a ton of keystrokes already, but I'm sure it can be written better, so I just select the first 10 lines and then run the macro once.

Here is what I still have:

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 each file I run this macro, it may not be the first 10 lines that need to be copied.

In fact, an even better macro would be to copy each row twice if the cell in column J is empty.

Update. The file has a header row with values ​​for columns A to X. The rows to be copied will be the first x # rows after the header, where column J is empty. Therefore, in one example, lines 2-11 need to be duplicated twice. But in another file it can be lines 2-21.

Answer 1

try the following:

 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 

Answer 2

Can I play too ?: P

Here is the quickest way to do this. Say your data is from cell A1:A10 . Just run this code.

You do not have to use Copy / Paste .

What this code does is insert blank lines and then simulate Ctrl + G → Special → Blank Cells → Fill an empty cell with data from the specified 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 3

Here is some code that will allow the user to enter a row counter and check if column J is empty for each row:

 Sub CopyRows() Dim x As Integer x = InputBox("How Many Rows to Copy?", 8) Dim c As Range Set c = Range("A2") Dim y As Integer For y = x to c.Row Step -1 If IsEmpty(Cells(y, "J")) Then Cells(y,1).EntireRow.Copy: Cells(y,1).Resize(2,1).EntireRow.Insert Shift:=xlDown End If Next End Sub 

Answer 4

If column A can be used to display the extents of rows for processing, then searching for the last completed row in column A and working on row 2 should cover all the rows that need to be processed.

 Sub add_Duplicate_Blank_Js() Dim rw As Long With Worksheets("Sheet4") With .Cells(1, 1).CurrentRegion For rw = .Rows.Count To 2 Step -1 If Not CBool(Len(.Cells(rw, "J"))) Then With .Rows(rw).Cells .Copy .Resize(2, .Columns.Count).Insert Shift:=xlDown End With End If Next rw Application.CutCopyMode = False End With End With End Sub 

With the headings in the first row and column A, filled to the full data area, the above will go back from the bottom to the top (recommended when inserting or deleting rows in For the next statement ) the Range.CurrentRegion property.