إدراج صفوف

[waledms]

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

هل توجد طريقة سريعة لإدراج صفوف فارغة بين الصفوف المحتوية على بيانات فى الشيت المرفق

أسماء العاملين بالمدرسة وبياناتهم 2017.rar

تم تعديل فبراير 17, 2018 بواسطه waledms

[سليم حاصبيا]

الحل هنا

الكود

Option Explicit
Sub salim_rows()
Dim t%
Dim lr%
Dim my_rg As Range
Application.ScreenUpdating = False
If ActiveSheet.Name <> "المدرسة " Then GoTo End_Me
lr = Cells(Rows.Count, 1).End(3).Row
On Error Resume Next
Set my_rg = Range("a4:m" & lr).SpecialCells(4)
my_rg.EntireRow.Delete
On Error GoTo 0
t = 6
    Do Until Cells(t, "A") = ""
        Rows(t).Insert
        t = t + 2
    Loop
End_Me:
Application.ScreenUpdating = True
End Sub

الملف مرفق

 

 

أسماء العاملين 2017 salim.xlsm