استخراج رقم واحد من كل 10 ارقام من عمود ما وترحيله الى صفحة أخرى

[بلانك]

1000.xlsx

عنوان مخالف جدا ... تـــم تعديل وتغيير عنوان المشاركة ليعبر عن طلبك

[lionheart]

Sub Test()
    Dim v, x, arr, ws As Worksheet, sh As Worksheet, p As Single, l As Long, lr As Long, ii As Long, k As Long
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    Set sh = ThisWorkbook.Worksheets("Sheet2")
    p = 0.1
    lr = ws.Range("A" & Rows.Count).End(xlUp).Row
    v = ws.Range("A1").Resize(lr).Value2
    ReDim w(1 To UBound(v) * p, 0)
    ReDim arr(1 To Int(UBound(v) * p), 1 To 7)
    For l = 1 To UBound(w)
        w(l, 0) = v(Application.RandBetween((l - 1) * 1 / p + 1, l * 1 / p), 1)
        x = Application.Match(Val(w(l, 0)), ws.Columns(1), 0)
        If Not IsError(x) Then
            k = k + 1
            For ii = LBound(arr, 2) To UBound(arr, 2)
                arr(k, ii) = ws.Cells(x, ii).Value
            Next ii
        End If
    Next l
    sh.Range("A1").Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
End Sub

 

[بلانك]

اشكرك جزيلا على الكود وهذا هو المطلوب  واطمع في دمج هذا الكود مع الكود في الملف التالي 

كود لاستدعاء نسبة العشرة في المية.xls

[lionheart]

Try it yourself. Study the code well then try to implement and show us your tries

[بلانك]

عفوا انا لست ضليع في الاكواد وهذا جهل مني ولكن اطمع في كرامكم

[lionheart]

You can use a helper column to put the results of the code posted here then simply copy the first 20 record to the first table and copy the second 20 record to the second

table

[بلانك]

فكرة جميلة ولكن هل من الصعوبة عمل الاستدعاء بشرطين كما في الكود الاول والكود الثاني مباشرا