سؤال في الترحيل من ورقة الى الى ورقة اخرى في جدول

[اوفيس 2003]

السلام عليكم ورحمة الله

 

لدي ورقة 01 بها عمود به  5000 رقم كودي للمصنع  ،، اريد نقل هذه الأرقام الى ورقة 02 ولكن على شكل جدوال بحيث الصفحة A4  تكون الجدول فيها عدد الصفوف 30 صف والأعمدة 7  اي ان الصفحة تأخذ 210 رقم  وتم تصميم الشكل المطلوب من حيث ارتفاع الصف وعرض العمود  ،،،، لو قمت بعمل ذلك يدوي سيكون متعب للغاية وسيأخذ وقت كبير حيث ان الأرقام الكودية متغيرة دوماً

 

اريد كود في ورقة 01  احدد منه عدد الأرقام المراد تحويلها الى الورقة 02 

وكود اخر لمسح كل مافي الجداول في ورقة 02  بحيث لو اردت تحديد عدد اخر للطباعة

 

 

 

مرفق مثال به ارقام في ورقة 01 وعمود ب 5000  تم نقل منهم يدوياً الى ورقة 02 جدول واحد

 

 

 

Test.rar

[عبدالله باقشير]

السلام عليكم

كود الترحيل

Sub kh_Start()
Dim x
Dim Cont As Integer, M As Integer, Z As Integer
Dim r As Integer, rr As Integer, c As Integer, cc As Integer
1:
x = InputBox("ادخل عدد الارقام . ")
If x = Cancel Then Exit Sub
x = Val(x)
If x = 0 Then GoTo 1
Cont = Abs(Int(-x / 30))
M = x Mod 30
rr = 1
Z = 30
Sheets("02").UsedRange.ClearContents

For r = 1 To x Step 30
    c = c + 1
    cc = cc + 1
    If cc = Cont Then If M Then Z = M
    Sheets("02").Cells(rr, c).Resize(Z, 1).Value = Sheets("01").Cells(r, 1).Resize(Z, 1).Value
    If c = 7 Then c = 0: rr = rr + 30
Next
    
End Sub

كود المسح

Sub kh_Clear()
Sheets("02").UsedRange.ClearContents
End Sub

شاهد المرفق 2010

ترحيل الى جدول.rar

[اوفيس 2003]

جزاك الله كل خير  ،، هذا ما اريد استاذنا المحترم

 

وبارك الله في كل اهل اليمن الخبراء الكرماء

[الـعيدروس]

السلام عليكم

الاستاذ العبقري عبدالله باقشير

لطالما تبهرنا بأكوادك الخبوريه

كود المختصر المفيد 

حقيقة أنا معقد من الرياضيات

الكود هذا ذكرني باأيام س ص

حاولنا نفكفك الحسبه تهنا

جزاك الله كل خير 

إبداع وتميز وإتقان الحرفه

تقبلو مروري

[عبدالله باقشير]

السلام عليكم

 

اخي الحبيب عباد............ حفظكم الله

 

اسعدني مروركم ..جزاكم الله خيرا وبارك فيكم.....

......تقبلوا تحياتي وشكري