اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

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


إذهب إلى أفضل إجابة Solved by محي الدين ابو البشر,

الردود الموصى بها

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

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

رابط هذا التعليق
شارك

السلام عليكم

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

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

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

  • Like 2
رابط هذا التعليق
شارك

  • أفضل إجابة

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

كود:

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

  • Like 3
رابط هذا التعليق
شارك

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

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

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

رابط هذا التعليق
شارك

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

  • Like 1
رابط هذا التعليق
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information