مطلوب كود بسيط يضيف سطر فارغ تحت كل سطر به بيانات

[يوسف عطا]

السلام عليكم اخوتنا الكرام
طلب تعليمي لو تكرمتم
مطلوب طريقة كتابة كود بسيط يضيف سطر فارغ تحت كل سطر به بييانات فى شيت اكسيل 2003
الرجاء شرج كل سطر فى الكود
ولكم جزيل الشكر و التقدير

[hegazee]

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

تفضل أخي الكريم

Sub InsertBlankRowForAllColumns()
    Dim lastRow As Long
    Dim lastColumn As Long
    Dim i As Long, j As Long

    ' تحديد آخر صف وآخر عمود يحتويان على بيانات
    lastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    lastColumn = Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column

    ' البدء من آخر صف والعمل إلى الأعلى
    For i = lastRow To 2 Step -1
        ' التحقق من وجود بيانات في أي من الأعمدة
        For j = 1 To lastColumn
            If Cells(i, j).Value <> "" Then
                Rows(i + 1).Insert Shift:=xlDown
                Exit For ' الخروج من الحلقة الداخلية إذا وجدنا بيانات
            End If
        Next j
    Next i
End Sub

 

إضافة صف.xlsm

[عبدالله بشير عبدالله]

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

بعد اذن الاستاذ  حجازى واثراءا للموضوع واظافة وهي عدم السماح للصف الذي به بيانات باظافة صف فارغ الا مرة واحدة

الكود

Private Sub CommandButton1_Click()
    Dim i As Long
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim nextRowData As Long
    Set ws = ActiveSheet
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    lastRow = ws.Cells.Find(What:="*", After:=ws.Cells(1, 1), LookIn:=xlFormulas, _
                            LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, _
                            SearchFormat:=False).Row

    For i = lastRow To 2 Step -1
        If Application.WorksheetFunction.CountA(ws.Rows(i)) > 0 Then
            nextRowData = Application.WorksheetFunction.CountA(ws.Rows(i + 1))
            If nextRowData > 0 Then
                ws.Rows(i + 1).Insert Shift:=xlDown
            End If
        End If
    Next i
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
End Sub

الملف

إضافة صف فارغ.xlsm

 

تم تعديل أكتوبر 6, 2024 بواسطه عبدالله بشير عبدالله

[hegazee]

تحياتي للأستاذ/ عبدالله و لكن الكود يتعامل فقط مع أول عمود إذا كان به بيانات ولا يضيف صفوف إذا كان العمود الأول فارغا

Aالعمود

[عبدالله بشير عبدالله]

 نعم لديك كل الحق نم التعديل في المشاركة السابقة

[يوسف عطا]

السلام عليكم
الأخ حجازي حفظه الله
الأخ عبدالله خفظه الله
الف شكر لكما و جارى تجربة الأكواد
تقبلا التحيات من القلب
جعل الله اعمالكم فى موازين حسناتكم
دمتما فى رعاية الله