إدراج صف جديد بعد كل صف به بيانات..

[حامل المسك]

السلام عليكم ورحمة الله وبركاته ..

وفقكم الله تعلمون أن اكسل به أعمدة A b c d إلى آخره

وصفوف 1 2 3 4 إلخ 

لدي بيانات في مجموعة من الصفوف 

أريد إدراج صف فارغ بعد كل صف به بيانات مع جزيل الشكر وفقكم الله ..

[حامل المسك]

مرفق مثال للتعديل

المصنف1.rar

[مختار حسين محمود]

Option Explicit

Sub Mokhtar_Inserting_blank_row_after_every_row_with_data()
Dim R As Long, Fr As Long, Lr As Long
 With Application
      .Calculation = xlCalculationManual
      .ScreenUpdating = False
      .EnableEvents = False
      .DisplayAlerts = False
 End With
Fr = ActiveSheet.Range("B8").Row                        ' أول صف به بيانات
Lr = ActiveSheet.Range("B8").End(xlDown).Row            ' آخر صف به بيانات
For R = Lr To Fr Step -1
    If Application.WorksheetFunction.CountA(Rows(R)) > 0 Then ' شرط اضافة الصف الفارغ : أن يكون الصف به بيانات
       Rows(R).Insert shift:=xlDown
       Else
    End If
Next R
With Application
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
    .EnableEvents = True
    .DisplayAlerts = True
End With
 
End Sub

ضع الكود فى مديول عادى

[قلم-الاكسل(عبدالعزيز)]

شكرا استاذنا مختار

وكود ممتاز

مبدع

الله يبارك فيك دووما

 

[مختار حسين محمود]

ربنا يبارك فيك أخى عبدالعزيز       تحياتى

لمنع تحريك الخلية الاولى من مكانها ضع السطر ده

Fr = ActiveSheet.Range("B8").Offset(1).Row             ' أول صف به بيانات +1

مكان السطر

Fr = ActiveSheet.Range("B8").Row              ' أول صف به بيانات

 

 

 

[حامل المسك]

مبدع مبدع ماشاء الله تبارك الله 

زادكم الله نورا وهدى وتوفيقا ..

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

بسم الله ما شاء الله عليك أخي الغالي مختار

نشاط رائع ومجهود فوق العادة .. لا حرمنا الله منك

إثراءً للموضوع إليكم الكود التالي

رابط الكود من هنا

[محمد عبدالسلام]

 

اخي مختار حسين محمود ما شاء الله عليك جزاك الله خيرا

 

[abassreda]

جزاكم الله كل خير كود محترم