Itt egy másfajta megközelítés:

Sub veletlen()

    Dim XRange As Range, c As Range, db As Long, i As Long
    Dim wsSrc As Worksheet, wsTgt As Worksheet
    
    Set wsSrc = ActiveSheet
    
    Set XRange = Intersect(wsSrc.Columns(wsSrc.Columns.Count), wsSrc.UsedRange.EntireRow)
    db = InputBox("Hány sort akarsz másolni?")
    If db > XRange.Cells.Count Then
        MsgBox "Az túl sok."
        Exit Sub
    End If
    While Application.WorksheetFunction.CountA(XRange) < db
        i = Int(Rnd() * XRange.Cells.Count) + 1
        XRange(i) = "x"
    Wend
    
    Set wsTgt = ThisWorkbook.Worksheets.Add
    For Each c In XRange
        If c = "x" Then c.EntireRow.Copy wsTgt.Range("A" & wsTgt.Rows.Count).End(xlUp).Offset(1)
    Next
    XRange.ClearContents
    wsTgt.Columns(wsTgt.Columns.Count).ClearContents
End Sub