Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- Sub CopyRandomRows()
- Sheets("Random Sample").Select
- Cells.Select
- Range("C14").Activate
- Selection.Delete Shift:=xlUp
- Windows("Critical Infotype Raw Data.xlsx").Activate
- Rows("1:1").Select
- Selection.Copy
- Application.CutCopyMode = False
- Selection.Copy
- Windows("Critical Infotype Sampling Tool.xlsm").Activate
- Sheets("Random Sample").Select
- Rows("1:1").Select
- ActiveSheet.Paste
- Dim source As Range, target As Range, randCount&, data(), value, r&, rr&, c&
- ' this defines the source to take the data
- Set source = Workbooks("Critical Infotype Raw Data.xlsx").Worksheets("Sheet1").Range("A2:L5215")
- ' this defines the target to paste the data
- Set target = Workbooks("Critical Infotype Sampling Tool.xlsm").Worksheets("Random Sample").Range("A2")
- ' this defines the number of rows to generate based on the input in textbox
- randCount = Worksheets("Main").TextBox1.value
- ' this load the data in an array
- data = source.value
- 'this shuffle the rows
- For r = 1 To randCount
- rr = 1 + Math.Round(VBA.rnd * (UBound(data) - 1))
- For c = 1 To UBound(data, 2)
- value = data(r, c)
- data(r, c) = data(rr, c)
- data(rr, c) = value
- Next
- Next
- ' this writes the data to the target
- target.Resize(randCount, UBound(data, 2)) = data
- MsgBox "Random Sample Generated!"
- End Sub
- ' this defines the source to take the data
- Set source = Workbooks("Critical Infotype Raw Data.xlsx").Worksheets("Sheet1").Range("A2:L5215")
- With Workbooks("Critical Infotype Raw Data.xlsx").Worksheets("Sheet1")
- Set Source = .Range("A1:" & .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, .Cells(1, .Columns.Count).End(xlToLeft).Column).Address)
- End With
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement