Microsoft Excel - Is there a way to copy multiple rows and then insert duplicates below? vba?

Asked By Jo on 05-Dec-12 09:45 AM
Is there a way to copy multiple rows and then insert 1 or 2 duplicate lines below? vba?

Preferably by selecting a range and then running something...


1 breakdown
2 short stop

1 breakdown
2 breakdown
3 breakdown
4 short stop
5 short stop
6 short stop

Robbe Morris replied to Jo on 05-Dec-12 01:26 PM
You'd need to write your own macro.  As I always suggest, use the macro recorder in Excel to record you manually performing the task.  Then, stop the recorder and look at the code it generated.  Modify as needed.
wally eye replied to Jo on 06-Dec-12 09:46 AM
Something like:

Public Sub DuplicateRows()

    Dim arrValues         As Variant
    Dim arrOutput         As Variant

    Dim strCopies         As String
    Dim intCopies         As Integer
    Dim intRow          As Integer
    Dim intCopy         As Integer
    Dim intCol          As Integer

    strCopies = InputBox("How many total copies do you want?", "Copy Rows")
    If IsNumeric(strCopies) Then
      intCopies = CInt(strCopies)
      If intCopies > 1 Then
        arrValues = Selection.Value
        ReDim arrOutput(LBound(arrValues, 1) To UBound(arrValues, 1) * intCopies, _
          LBound(arrValues, 2) To UBound(arrValues, 2))
        For intRow = LBound(arrValues, 1) To UBound(arrValues, 1)
          For intCopy = 1 To intCopies
            For intCol = LBound(arrValues, 2) To UBound(arrValues, 2)
              arrOutput((intRow - LBound(arrValues, 1)) * intCopies + intCopy, intCol) = _
                arrValues(intRow, intCol)
            Next intCol
          Next intCopy
        Next intRow
        Selection.Cells(1, 1).Resize(UBound(arrOutput, 1) - LBound(arrOutput, 1) + 1, _
          UBound(arrOutput, 2) - LBound(arrOutput, 2) + 1).Value = arrOutput
      End If
    End If

End Sub

You would put this in a new module, and can assign a hot-key to make it easy to access from the worksheet.