在选定范围VBA中剪切指定的行数

时间:2018-10-11 12:40:21

标签: excel vba

我有问题, 我在工作表中有180行,我想随机选择,例如从A2到工作表末尾的18行,除了第一个,因为会有列标题,然后将其粘贴到新工作表中,

1 个答案:

答案 0 :(得分:0)

以下代码将实现您想要的功能,它将在2和最后一行数据之间生成18个随机数,在您的情况下为第180行,然后将该行复制到Sheet2的下一个空闲行:

Sub foo()
Dim wsOriginal As Worksheet: Set wsOriginal = ThisWorkbook.Worksheets("Sheet1")
Dim wsDestination As Worksheet: Set wsDestination = ThisWorkbook.Worksheets("Sheet2")
'declare and set the worksheets you are working with, amend as required
Dim i As Long, LastRowOrig As Long, LastRowDest As Long

LastRowOrig = wsOriginal.Cells(wsOriginal.Rows.Count, "A").End(xlUp).Row
'get the last row with data on Column A on your Sheet with data

For i = 1 To 18 'loop 18 times
    RandNumber = Int((LastRowOrig - 2 + 1) * Rnd + 2)
    'generate a random number between 2 and 180 (Last Row)
    LastRowDest = wsDestination.Cells(wsDestination.Rows.Count, "A").End(xlUp).Row + 1
    'get the last row with data on Destination sheet and offset by one (i.e. next free row)
    wsOriginal.Rows(RandNumber).Copy 'copy the row
    wsDestination.Rows(LastRowDest).PasteSpecial xlPasteAll 'paste the row
Next i
End Sub

更新:

要反映您的评论并添加包含随机行的新工作簿,请使用以下代码:

Sub foo()
Dim wsOriginal As Worksheet: Set wsOriginal = ThisWorkbook.Worksheets("Sheet1")
Dim wsDestination As Worksheet
Dim i As Long, LastRowOrig As Long, LastRowDest As Long

Set NewWorkbook = Workbooks.Add 'create a new workbook
    With NewWorkbook
        .Title = "Random Rows" 'You can modify this value.
        .SaveAs Filename:="C:\Users\doneby\Desktop\RandomGeneratedRows.xlsx"
        'amend the line above to the path you and name of the file you want to create
    End With
Set wsDestination = NewWorkbook.Worksheets("Sheet1") 'specify the Sheet of the new workbook
'declare and set the worksheets you are working with, amend as required

LastRowOrig = wsOriginal.Cells(wsOriginal.Rows.Count, "A").End(xlUp).Row
'get the last row with data on Column A on your Sheet with data

For i = 1 To 18 'loop 18 times
    RandNumber = Int((LastRowOrig - 2 + 1) * Rnd + 2)
    'generate a random number between 2 and 180 (Last Row)
    LastRowDest = wsDestination.Cells(wsDestination.Rows.Count, "A").End(xlUp).Row + 1
    'get the last row with data on Destination sheet and offset by one (i.e. next free row)
    wsOriginal.Rows(RandNumber).Copy 'copy the row
    wsDestination.Rows(LastRowDest).PasteSpecial xlPasteAll 'paste the row
Next i
NewWorkbook.Close SaveChanges:=True
'close and save the new workbook
End Sub