如何修改VBA宏实现随机选择多行并复制到其他工作表？

方案1：不重复随机行（推荐） #

以下代码可以指定要复制的行数，且确保选中的行不重复，同时优化了原代码的Select操作（避免低效和误操作）：

Sub CopyRandomMultipleRows()
    ' 定义要复制的随机行数，可根据需求修改数值
    Const COPY_ROWS_COUNT As Integer = 5
    
    Dim sourceSheet As Worksheet
    Dim targetSheet As Worksheet
    Dim populationRange As Range
    Dim firstRow As Long, lastRow As Long
    Dim randomRows As Collection
    Dim i As Long, randomRow As Long
    
    ' 绑定源工作表和目标工作表
    Set sourceSheet = ThisWorkbook.Sheets("GB-151")
    Set targetSheet = ThisWorkbook.Sheets("Sheet13")
    
    ' 清空目标区域原有内容
    targetSheet.Range("A15:I50").Clear
    
    ' 设置源数据的行范围（对应A9:A346的整行）
    Set populationRange = sourceSheet.Range("A9:A346")
    firstRow = populationRange.Row
    lastRow = populationRange.Row + populationRange.Rows.Count - 1
    
    ' 用集合存储不重复的随机行号
    Set randomRows = New Collection
    On Error Resume Next ' 捕获重复添加行号的错误
    Do Until randomRows.Count = COPY_ROWS_COUNT
        randomRow = Application.WorksheetFunction.RandBetween(firstRow, lastRow)
        ' 通过Key参数确保行号唯一，避免重复选中同一行
        randomRows.Add randomRow, Key:=CStr(randomRow)
    Loop
    On Error GoTo 0 ' 恢复正常错误捕获
    
    ' 循环复制选中的随机行到目标工作表
    For i = 1 To randomRows.Count
        sourceSheet.Rows(randomRows(i)).Copy _
            targetSheet.Range("A15").Offset(i - 1, 0)
    Next i
End Sub

方案2：允许重复随机行（代码更简洁） #

如果不需要避免重复选中同一行，可以使用以下简化版本：

Sub CopyRandomMultipleRows_AllowDuplicates()
    ' 定义要复制的随机行数，可自行修改
    Const COPY_ROWS_COUNT As Integer = 5
    
    Dim sourceSheet As Worksheet
    Dim targetSheet As Worksheet
    Dim populationRange As Range
    Dim firstRow As Long, lastRow As Long
    Dim i As Long, randomRow As Long
    
    Set sourceSheet = ThisWorkbook.Sheets("GB-151")
    Set targetSheet = ThisWorkbook.Sheets("Sheet13")
    
    targetSheet.Range("A15:I50").Clear
    
    Set populationRange = sourceSheet.Range("A9:A346")
    firstRow = populationRange.Row
    lastRow = populationRange.Row + populationRange.Rows.Count - 1
    
    ' 循环生成随机行并复制
    For i = 1 To COPY_ROWS_COUNT
        randomRow = Application.WorksheetFunction.RandBetween(firstRow, lastRow)
        sourceSheet.Rows(randomRow).Copy targetSheet.Range("A15").Offset(i - 1, 0)
    Next i
End Sub

关键修改说明 #

• 可自定义行数：通过修改COPY_ROWS_COUNT的数值，直接调整要复制的随机行数。
• 移除冗余操作：替换原代码的Select/Selection为直接操作工作表对象，提升运行效率并减少出错概率。
• 去重逻辑：方案1使用Collection的Key参数确保随机行号唯一，避免重复复制同一行数据。

内容的提问来源于stack exchange，提问作者Wolfgang Ammaschell