CODEWITHSUNDEEP
excel
StabMe
StabMe

Reputation: 11

How to automatically make copies of rows in Excel?

I have an excel file which looks like this:
row1_cell1 row1_cell2 row1_cell3
row2_cell1 row2_cell2 row2_cell3
row3_cell1 row3_cell2 row3_cell3

How can i make three (or any number of) copies of each row that i have in the sheet, which i would like to be added after the row being copied? So, in the end i would like to have this kind of a result:
row1_cell1 row1_cell2 row1_cell3
row1_cell1 row1_cell2 row1_cell3
row1_cell1 row1_cell2 row1_cell3
row2_cell1 row2_cell2 row2_cell3
row2_cell1 row2_cell2 row2_cell3
row2_cell1 row2_cell2 row2_cell3
row3_cell1 row3_cell2 row3_cell3
row3_cell1 row3_cell2 row3_cell3
row3_cell1 row3_cell2 row3_cell3

Upvotes: 1

Views: 12791

Answers (3)

Wolfgang
Wolfgang

Reputation: 1

Old thread, however someone might find this useful: The below information was copied from here

I needed to do almost the opposite. I needed the formula to increment by 1 every 22 rows, leaving the 21 rows between blank. I used a modification of the formula above and it worked great. Here is what I used:

=IFERROR(INDIRECT("J"&((ROW()-1)*1/22)+1),"")

The information was in column "J".

The "IFERROR" portion handles the error received when the resulting row calculation is not an integer and puts a blank in that cell.

Hope someone finds this useful. I have been looking for this solution for a while, but today I really needed it. Thanks.

Upvotes: 0

Jerry Beaucaire
Jerry Beaucaire

Reputation: 3197

This is how I would do that for all rows on the sheet:

Option Explicit

Sub MultiplyRows()
Dim RwsCnt As Long, LR As Long, InsRw As Long

RwsCnt = Application.InputBox("How many copies of each row should be inserted?", "Insert Count", 2, Type:=1)    
If RwsCnt = 0 Then Exit Sub
LR = Range("A" & Rows.Count).End(xlUp).Row

Application.ScreenUpdating = False
For InsRw = LR To 1 Step -1
    Rows(InsRw).Copy
    Rows(InsRw + 1).Resize(RwsCnt).Insert xlShiftDown
Next InsRw
Application.ScreenUpdating = True

End Sub

Upvotes: 1

SF Lee
SF Lee

Reputation: 1777

There isn't a direct way to paste them interleaved like what you wanted. However, you can create a temporary VBA to do what you want.

For example, you can:-

  1. Create a VBA procedure (like the one below) in your Excel file.
  2. Assign a keyboard shortcut (eg. Ctrl+Q) to it.
    • To do this, press Alt+F8, then select the macro, then click 'Options'.
  3. Select the cells you want to copy, then press Ctrl+C.
  4. Select the cell you want to paste in, then press Ctrl+Q (or whatever keyboard shortcut you chose).
  5. Enter the number of times you want to copy. (In your example, it would be 3.)
  6. WHAMMO! :D
  7. Now you can delete the VBA procedure. :)

VBA Code:

Sub PasteAsInterleave()
    Dim startCell As Range
    Dim endCell As Range
    Dim firstRow As Range
    Dim pasteCount As Long
    Dim rowCount As Long
    Dim colCount As Long
    Dim i As Long
    Dim j As Long
    Dim inputValue As String

    If Application.CutCopyMode = False Then Exit Sub

    'Get number of times to copy.
    inputValue = InputBox("Enter number of times to paste interleaved:", _
                 "Paste Interleave", "")
    If inputValue = "" Then Exit Sub  'Cancelled by user.

On Error GoTo Error
    pasteCount = CInt(inputValue)
    If pasteCount <= 0 Then Exit Sub
On Error GoTo 0

    'Paste first set.
    ActiveSheet.Paste
    If pasteCount = 1 Then Exit Sub

    'Get pasted data information.
    Set startCell = Selection.Cells(1)
    Set endCell = Selection.Cells(Selection.Cells.count)
    rowCount = endCell.Row - startCell.Row + 1
    colCount = endCell.Column - startCell.Column + 1
    Set firstRow = Range(startCell, startCell.Offset(0, colCount - 1))

    'Paste everything else while rearranging rows.
    For i = rowCount To 1 Step -1
        firstRow.Offset(i - 1, 0).Copy

        For j = 1 To pasteCount
            startCell.Offset(pasteCount * i - j, 0).PasteSpecial
        Next j
    Next i

    'Select the pasted cells.
    Application.CutCopyMode = False
    Range(startCell, startCell.Offset(rowCount * pasteCount - 1, colCount - 1)).Select
    Exit Sub

Error:
    MsgBox "Invalid number."
End Sub

Upvotes: 0

Related Questions