• API
• FAQ
• Tools
• Archive
SHARE
TWEET

# Untitled

a guest Jul 24th, 2019 60 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
1. Sub CopyRandomRows()
2.
3.     Sheets("Random Sample").Select
4.     Cells.Select
5.     Range("C14").Activate
6.     Selection.Delete Shift:=xlUp
7.
8.     Windows("Critical Infotype Raw Data.xlsx").Activate
9.     Rows("1:1").Select
10.     Selection.Copy
11.     Application.CutCopyMode = False
12.     Selection.Copy
13.     Windows("Critical Infotype Sampling Tool.xlsm").Activate
14.     Sheets("Random Sample").Select
15.     Rows("1:1").Select
16.     ActiveSheet.Paste
17.
18.     Dim source As Range, target As Range, randCount&, data(), value, r&, rr&, c&
19.
20.     ' this defines the source to take the data
21.     Set source = Workbooks("Critical Infotype Raw Data.xlsx").Worksheets("Sheet1").Range("A2:L5215")
22.
23.     ' this defines the target to paste the data
24.     Set target = Workbooks("Critical Infotype Sampling Tool.xlsm").Worksheets("Random Sample").Range("A2")
25.
26.     ' this defines the number of rows to generate based on the input in textbox
27.     randCount = Worksheets("Main").TextBox1.value
28.
29.     ' this load the data in an array
30.     data = source.value
31.
32.     'this shuffle the rows
33.     For r = 1 To randCount
34.         rr = 1 + Math.Round(VBA.rnd * (UBound(data) - 1))
35.         For c = 1 To UBound(data, 2)
36.             value = data(r, c)
37.             data(r, c) = data(rr, c)
38.             data(rr, c) = value
39.         Next
40.     Next
41.
42.     ' this writes the data to the target
43.     target.Resize(randCount, UBound(data, 2)) = data
44.
45.      MsgBox "Random Sample Generated!"
46.
47. End Sub
48.
49. ' this defines the source to take the data
50. Set source = Workbooks("Critical Infotype Raw Data.xlsx").Worksheets("Sheet1").Range("A2:L5215")
51.
52. With Workbooks("Critical Infotype Raw Data.xlsx").Worksheets("Sheet1")
53.     Set Source = .Range("A1:" & .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, .Cells(1, .Columns.Count).End(xlToLeft).Column).Address)
54. End With
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.

Top