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. OK, I Understand
 
Top