شرح جزء من هذا الكود

[بلانك]

المطلوب داخل الملف والصورة المرفقة ولكم جزيل الشكر مقدما

لصق دباجة اسفل كل شيت.xlsm

[AbuuAhmed]

على قد فهمي فأنا محسوب على منتدى الأكسس وكثير من أوامر ودوال الاكسل لا أستخدمها.
 

Sub salim_rows()
    Dim t%, lr%, x%, z%, a%
    Dim my_rg As Range, k%
    Dim In_box, Col As Integer

    
    Application.ScreenUpdating = False
    
    If ActiveSheet.Name <> "m" Then GoTo End_Me
    del_Empty_rows
    In_box = Application.InputBox("How Many Rows", , 14)

    a = In_box - 1 'number of rows for every group
    z = 3 'number of rows to be insert every time
    x = 8 'first row to begine
    If a <= 0 Then Exit Sub
    t = x + a + 1
    If z > 5 Then z = 5

    '----------------------------------------
    'العمود الثاني
    Col = 2
    'لإيجاد آخر سطر للعمود الثاني .. فهو يذهب لآخر الصفحة ثم يعود للخلف ليقف على آخر سطر
    'lr = Cells(Rows.Count, 2).End(3).Row
    lr = Cells(Rows.Count, Col).End(xlUp).Row
    'تقوم بإرجاع كائن نطاق يمثل كافة الخلايا الفاضية في العمود الثاني
    'Set my_rg = Range("B" & x & ":B" & lr).SpecialCells(4)
    On Error Resume Next
    Set my_rg = Range(Cells(x, Col), Cells(lr, Col)).SpecialCells(xlCellTypeBlanks)
    '----------------------------------------
    
    my_rg.EntireRow.Delete
    
    On Error GoTo 0
    
    Do Until Cells(t, "B") = ""
        Rows(t).Resize(z).Insert
        Sheets("m").Range("My_DEB").Copy _
        Cells(t, 1)
        t = t + a + z + 1
    Loop
End_Me:

    Application.ScreenUpdating = True
End Sub

 

تم تعديل يناير 25 بواسطه AbuuAhmed

[بلانك]

بارك الله فيك استاذي الاستاذ AbuuAhmed الكود يعمل بكفاءة ولكن اطمع في كرمك ...... اريد حذف الدباجة نهائيا من الورقة وكود الحذف نفس الكود السابق عند تغير اي رقم لايستجيب انظر

[AbuuAhmed]

5 ساعات مضت, بلانك said:

كود الحذف نفس الكود السابق عند تغير اي رقم لايستجيب انظر

حياك الله أخي، لقد شرحت الكود في المشاركة السابقة، وها أنا أضع لك التعديل مرة أخرى لتركز فيه أكثر:
 

    '----------------------------------------
    Col = 2     'العمود الثاني .. رقم الجلوس
    'لإيجاد آخر سطر للعمود الثاني .. فهو يذهب لآخر الصفحة ثم يعود للخلف ليقف على آخر سطر
    lr = Cells(Rows.Count, Col).End(xlUp).Row
    'تقوم بإرجاع كائن نطاق يمثل كافة الخلايا الفاضية في العمود الثاني
    Set my_rg = Range(Cells(x, Col), Cells(lr, Col)).SpecialCells(xlCellTypeBlanks)
    '----------------------------------------

من الطبيعي إذا بدلت في الأرقام دون معرفتها ومعرفة جدواها ستوقف الكود.
توضيح للأرقام:
الرقم 2 هو رقم عمود رقم الجلوس وهو الرقم الوحيد الذي يمكنك التعديل عليه عند إزاحة/تغيير موقع العمود وبشرط أن لا تستخدم أسفل العمود أي يكون عند نهاية خاليا حتى نهاية الصفحة.
الرقم 3 هو قيمة الرمز xlUp ويعني للأعلى، وهذا لا تلمسه بالمرة.
الرقم 4 هو قيمة الرمز xlCellTypeBlanks ويعني الخلايا الفاضية. وهذ كذلك لا تلمسه بالمرة.

بالنسبة لوظيفة الكود لم أحاول فهمه وخصوصا من بصمته تعرفت على كاتبه وهو من الخبراء المتمكنين والذي لا يمكنني أن أعدل على أكواده، فرجاءً تواصل معه لأي تعديل منعا للإحراج.

تحياتي واعتذاري.

[بلانك]

شكرا جزيلا وبارك الله فيك ياخي وعذرا على تعب حضرتك ... اما بخصوص الكو بالفعل قد وضعت رسالتين للاستاذ الفاضل /سليم حاصبيا ولكن لم يرد عليا فلة العذر بسبب شغل او لم يرى الرسالة