ترحيل الاسماء

[فوزى فوزى]

السلام عليكم ورحمة الله وبركاته بعد اذنكم جميعا ممكن عمل كود ترحيل يرحل المسلسل والاسم ورقم العضوية على حسب العدد المدخل في الخلية F2 الى شيت كشف الطباعة بمعنى كتبنا فى الخلية  F2 عدد 25 يرحل كل 25 اسم الى الجدول الموجدود في شيت الطباعة وعندما يمتلئ الجدول الأول يرحل 25 اسم الى الجدول الثانى والثالث والرابع حتى تنتهى الاسماء وادامكم الله فى طاعته وجعلكم عونا لنا وللامثالنا

ترحيل الاسماء.xlsm

[أسامة البراوى]

السلام عليكم

اظن الأمر لا يحتاج الى كود للترحيل وممكن استعمال دالة Indirect مع دالة بسيطة لتعريف الصفحات معتمدة على الخلية F2  كما هي مكتوبة في الخانات F5 الى F14 كما في شيت "كشف الطباعة" بالملف المرفق

وممكن تسهل على نفسك الأمور أكتر وتطبع الجدول بعد ما تضيف Page Header  و Page Footer وتتحكم بارتفاع الاسطر لتحديد عدد الأسماء في كل صفحة كما بالشيت "كشف الطباعة 2" بنفس الملف ,

ترحيل الاسماء.xlsm

[محي الدين ابو البشر]

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

كود:

Sub test()
Dim a
Dim x&, i&, c&
Dim r As Range
Dim firstaddress As String
With Sheets("التقرير")
a = .Range(.Cells(6, 1), .Cells(6, 3).End(xlDown))
x = .Cells(2, 6)
End With
With Sheets("كشف الطباعة")
    Set r = .Columns("a").Find("م", , , 1)
    If Not r Is Nothing Then
     firstaddress = r.Address
        Do
           [r].Offset(1).Resize(x, UBound(a, 2)) = Application.IfError(Application.Index(a, _
                                                                Evaluate("Row(" & c + 1 & ":" & x + c & ")"), [{1, 2,3}]), "")
            Set r = .Columns("a").FindNext(r)
            c = c + x
        Loop Until r.Address = firstaddress
    End If
End With
End Sub

 

ترحيل الاسماء.xlsm

[فوزى فوزى]

استاذ اسامة الذى اكن له كل احترام وتقدير الف شكر على تعبك ومجهود ولكن كان الحل مطلوب بالكود لان فيه اعضاء نسقط عنهم العضوية فنقوم بحذفهم من الشيت لذا المعادلات لاتنفع 

استاذ محى ابو البشر الذى يمد لى يده فى كل مرة الف الف شكر حل جميل وهو اقرب الى ما اكون ولكن لى استفسار ان تم الغاء جزئية UBound(a, 2)

واستبدالها range او  cells شكل الكود هيكون الزاى

[محي الدين ابو البشر]

17 ساعات مضت, فوزى فوزى said:

UBound(a, 2)

هي (عدد أعمدة) وليس range او  cells!!!!!

[فوزى فوزى]

بداية جزاكم الله خيرا على هذا العمل الرائع الذي أسأل الله تعالى ان يجعله في ميزان حسناتكم ويجعلكم  في الجنة في أعلى مقاماتها ما شاء الله عليك أسأل الله لكم القبول والخير كله ظاهره وباطنه وشكرا على التوضيح

[محي الدين ابو البشر]

🙏