كود_ادراج صف جديد بين صفوف ورقة العمل

[جلال الجمال_ابو أدهم]

تم رفع هذا الكود فى مشاركة منفصله

حتى لا ننسى هذه المشاركة  

 

تم ارفاق  من الفاضل _ ا / أبوعبد الله_اكسلجى

 

مرفق الملف

INSERT_ROW_DOWN_EVERY_NON_BLANK_ROW.rar

 

 و لا تنسونا من صالح الدعاء

تحياتى

[abbermustfa]

اخي

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

لو ارفقت مع مواضيعك قليل من الشرح وادراج الكود والرابط الذي اتيت منه المشاركه فربما يستزيد القارئ من المناقشات ... فيزداد الموضوع دقه وتفصيلا

[ياسر خليل أبو البراء]

الأخت الكريمة

الكود بسيط جداً وهو يعتمد على حلقة تكرارية من آخر صف للصف الثاني ، مع إدراج صف فارغ فقط في حالة إذا كانت الخلية لا تساوي فراغ

حاولي دراسة الكود سطر سطر وإذا تعثرتي في أمرٍ ما فلتقومي بعمل مشاركة للسؤال عما استصعب عليكي

Sub Insert_Blank_Row()
    'تعريف متغير ليكون بمثابة عداد للحلقة التكرارية
    Dim i As Long
    
    'سطر لإيقاف خاصية اهتزاز الشاشة لتسريع الكود
    Application.ScreenUpdating = False
        
        'حلقة تكرارية من آخر صف للصف الثالث ولأن الحلقة معكوسة استخدمنا -1
        For i = Cells(Rows.Count, 1).End(xlUp).Row To 3 Step -1
        
            'إذا كانت الخلية في العمود الأول في الصف الهدف غير فارغة فإنه
            'يتم إدراج خلايا لأسفل في النطاق المحدد من العمود الأول للثاني
            If Len(Trim(Cells(i, 1))) <> 0 Then Range(Cells(i, "A"), Cells(i, "B")).Insert Shift:=xlDown
            
        'الانتقال للصف التالي
        Next i
    
    'إعادة خاصية اهتزاز الشاشة
    Application.ScreenUpdating = True
End Sub

مع التعديل في الكود الأصلي قليلاً

[جلال الجمال_ابو أدهم]

ياسر خليل أبو البراء

اخى الفاضل جزاك الله خيرا
وحشتنا مشاركاتك