Copying row to another sheet in multiple rows based on input

Question

I tried using below code for copying last row data into multiple rows based on input number but it keeps on copying to same row. Please suggest modifications in below code.

Sub CopyDataFromLastRowAndPaste()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim copyRange As Range
    Dim pasteRange As Range
    Dim numCopies As Integer
    Dim i As Integer

    Set ws = ThisWorkbook.Sheets("Sheet1") 

    lastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    MsgBox "last row." & lastRow
    
    ' Input number of copies to make
    numCopies = InputBox("Enter the number of copies to make:")

    ' Set the range to copy from (last row of column A)
    Set copyRange = ws.Rows(lastRow)

    ' Loop through and paste the copied range below the original row
    For i = 1 To numCopies
       lastRow = lastRow + 1
        Set pasteRange = ws.Rows(lastRow + i)
        
        copyRange.Copy
        pasteRange.PasteSpecial Paste:=xlPasteValues

         Next i
    Application.CutCopyMode = False
    MsgBox "Data copied and pasted successfully below the last row."
End Sub

Answer 1

Copy Last Row Multiple Times to Another Worksheet

• It is unclear which sheet is the source sheet, whose last row will be copied, and which is the destination sheet, the one that will be copied to. I have chosen Sheet1 as the source sheet. If it's the other way around, switch the variables sws and dws in the declarations below the comment Worksheets.

Sub CopyValuesFromLastRow()
    On Error GoTo ClearError
    
    ' Define constants:
    Const MAX_COPIES_ALLOWED As Long = 10
    
    ' Worksheets
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    Dim sws As Worksheet: Set sws = wb.Sheets("Sheet1")
    
    Dim dws As Worksheet: Set dws = ActiveSheet
    ' If this worksheet is always in 'ThisWorkbook',
    ' use 'wb.Activesheet' instead!!!
    
    If dws Is sws Then
        MsgBox "Cannot copy to the source sheet """ & sws.Name & """!", _
            vbExclamation
        Exit Sub
    End If
    
    ' Input
    
    Dim InputString As String:
    InputString = InputBox("Enter the number of copies to make:")
    
    On Error GoTo InputError
        Dim CopiesCount As Long: CopiesCount = InputString
    On Error GoTo ClearError
    
    If CopiesCount < 1 Or CopiesCount > MAX_COPIES_ALLOWED Then
        MsgBox "It is allowed to make only 1 to " & MAX_COPIES_ALLOWED _
            & " copies!", vbExclamation
        Exit Sub
    End If
    
    ' Ranges
    
    Dim srg As Range: ' Last Row
    With sws.UsedRange
        Set srg = .Rows(.Rows.Count)
    End With
    
    Dim drg As Range: ' First Available Row
    With dws.UsedRange
        Set drg = .Cells(1).Offset(.Rows.Count).Resize(, srg.Columns.Count)
    End With
    
    ' Copy.
    
    Dim r As Long
    
    For r = 1 To CopiesCount
        drg.Value = srg.Value
        Set drg = drg.Offset(1)
    Next r
    
    ' Inform.
    
    MsgBox "Copied values from last row of sheet """ & sws.Name & """" _
        & vbLf & CopiesCount & " time" & IIf(CopiesCount = 1, "", "s") _
        & " below the last row of sheet """ & dws.Name & """.", _
        vbInformation

ProcExit:
    Exit Sub
InputError:
    MsgBox "The input """ & InputString & """ is invalid.", vbExclamation
    Resume ProcExit
ClearError:
    MsgBox "Run-time error '" & Err.Number & "':" & vbLf & vbLf _
        & Err.Description, vbCritical
    Resume ProcExit
End Sub