الرجا مساعدة فى الاكسل

[alsyedaly]

الرجا مساعدة اريد اسهل طريقة لاضافة صفين فارغين تحت كل اسم فى الملف المرفق لانه مكون من اكثر من الفين اسم

[Mr,Ahmed]

يعنى عايز تضيف صفين تحت كل اسم في خطوة واحد لكل الشيت

[hassanalhawy]

الملف فى الرابط التالى
https://www.mediafire.com/?o4h5je4f03ofeio

[alsyedaly]

الف شكر للمساعدة
ولكن ممكن تشرح الطريقة لأتعلمها لأن عندى شغل تانى كثيربنفس الطريقة

[alsyedaly]

نعم وياريت يكون باسهل طريقة

[hassanalhawy]

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

    Application.ScreenUpdating = False
    Dim AA, bb, c As Integer
    A = InputBox("أدخل رقم الصف الأول الذى تريد إدراج صفين خالى أعلاه ؟")
    AA = Val(A)
    b = InputBox("أدخل عدد الصفوف")
    bb = Val(b)
    c = bb * 3 + AA - 1
    For i = AA To c Step 3
    
    Dim D As String
    D = Str$(i)
    Rows(D).Select
    Selection.Insert Shift:=xlDown
    ' الخطوات السابقة تقوم بإدراج صف أعلى بنفس تنسيق الصف الأسفل....  وإذا أردت خذف هذا التنسيق قم بإزالة علامة التعليق  عن السطر التالى
    'Selection.FormatConditions.Delete
    Selection.Insert Shift:=xlDown
    ' الخطوات السابقة تقوم بإدراج صف أعلى بنفس تنسيق الصف الأسفل.... وإذا أردت خذف هذا التنسيق قم بإزالة علامة التعليق  عن السطر التالى
    'Selection.FormatConditions.Delete
    Next i
    Application.ScreenUpdating = True
    Range("A1").Select

عند تشغيل الكود سوف يسألك عن رقم الصف الأول الذى تريد إدراج صفين خالى أعلاه ؟ وستقوم بإدخال العدد 2
ثم سيسألك عن عدد الصفوف فى ورقة العمل الذى تريد إضافة صفين أعلاهم
وستقوم بإدخال - على ما أتذكر - 3000 أو أكثر

[alsyedaly]

الف شكر للمجهود
وجعلكم الله عونا لكل محتاج