طلب تعديل في كود إضافة صف

[أبو عبدالإله]

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

 

تحملوني أحبتي فالتلميذ لا غنى له عن أساتذته 

 

 هل يمكن إضافة أمر وهو (  الاحتفاظ بنفس تنسيقات ومعادلات الصف السابق ) في هذا الكود وهو لإضافة صف :

Sub CommandButton1_Click()
Dim ws As Worksheet
Dim lr As Long

Set ws = ActiveSheet
lr = ws.Cells(Rows.Count, "AZ").End(xlUp).Row
ws.Range("AZ" & lr).EntireRow.Insert
End Sub

 

 

وفقكم الله ورعاك .

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

ارفق ملفك للتوضيح ولمحاولة المساعدة

[أبو عبدالإله]

بارك الله فيك

 

هذا النموذج

 

 1.rar

[خالد الرشيدى]

 احد الطرق علها تفى بالغرض......المرفق

  1_2.rar

 

تم تعديل أغسطس 14, 2015 بواسطه خالد الرشيدى

[عبد العزيز البسكري]

 احد الطرق علها تفى بالغرض......المرفق

  1_2.rar

 

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

عمل في القمّة .. بارك الله فيك و لك .. و زادها بميزان حسناتك

                                                                                تحياتي

[خالد الرشيدى]

شكرا جزيلاً لك اخى عبد العزيز

         

    خالص حبى واحترامى

 

[أبو عبدالإله]

 احد الطرق علها تفى بالغرض......المرفق

  1_2.rar

 

 

عمل أكثر من رائع ويفي بالمطلوب تماما .

 

بارك الله فيك أخي خالد ، فقد أبدعت 

 

 

 

 

 

 

أخي الغالي خالد :

لاحظت أنه عند إضافة صف فإن الصف الجديد يكون في أعلى الصف السابق 

 

فهل يمكن أن تكون الإضافة في الأسفل .

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

الإضافة تتم في أسفل آخر صف ..!!

وضح المطلوب بشيء من التفصيل

[أبو عبدالإله]

حياك الله أستاذي ياسر

 

عمل الآستاذ خالد الرشيدي رائع 

 ولكن عند الكتابة في جميع الصفوف واختيار اضافة صف جديد فإن الإضافة لا تتم بعد السطر الأخير ، كما أنها تضيف صف بنفس البيانات المدخلة . بمعني أن الصف المضاف لايكون فارغا بل فيه بيانات مدخلة 

وأنا أريد إضافة صف بعد السطر الأخير ويكون بنفس معادلات الصف السابق ولكن بدون بيانات مدخلة 

 

شاكر ومقدر وقتكم الثمين

[خالد الرشيدى]

اخى الفاضل وكما اوضح  استازى ابو البراء    

الإضافة تتم في أسفل آخر صف ..!!

ولفهم عمل الكود قم بتحديد اخر صف بة بيانات ثم كليك يمين واختر  Insert   ولاحظ ....

 

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

جرب هذا التعديل .. حاول أن تبتعد عن دمج الخلايا لأنه يسبب مشاكل مع الأكواد

Sub khaled()
    Application.ScreenUpdating = False
        Cells(Rows.Count, 4).End(xlUp).Offset(1, 0).Select
        Rows(Selection.Row - 1).Copy
        Rows(Selection.Row).Insert Shift:=xlDown
        On Error Resume Next
        Rows(Selection.Row).SpecialCells(xlConstants).ClearContents
        On Error GoTo 0
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

 

تم تعديل أغسطس 14, 2015 بواسطه ياسر خليل أبو البراء

[أبو عبدالإله]

اخى الفاضل وكما اوضح  استازى ابو البراء    

الإضافة تتم في أسفل آخر صف ..!!

ولفهم عمل الكود قم بتحديد اخر صف بة بيانات ثم كليك يمين واختر  Insert   ولاحظ ....

 

كل الشكر والتقدير لجهودك أستاذي خالد .

عند تعبئة صفوف الجدول ببيانات واختار اضافة صف فإن الصف لا يأتي بعد السطر الأخير ، كما أن الصف المضاف تكون فيه بالإضافة إلى المعادلات البيانات التي أضقتها بمعني ينسخ نفس الأسماء .

 

كنت أريد نفس آلية عمل كود حذف صف ولكن عند الاضافة تكون بنفس المعادلات فقط .

 

لو تجرب ملء الجدول ببيانات ثم اختر اضافة صف ستتضح لك الصورة بشكل أكبر .

 

يبدو أني لم أوضح المطلوب جيدا وأعتذر عن ذلك .

 

كل الحب والود لك أستاذي الفاضل .

[خالد الرشيدى]

اخى الفاضل

لقد قمت باضافة المشاركة السابقة دون ان انتبة الى مشاركتك التى فيها التوضيح او انها لم تظهر عندى الا بعد اعادة تحميل صفحة الموضوع

عموماً استازى ابو البراء قام بالمطلوب

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

On Error Resume Next

استازى ابو البراء جعل الله جهودك فى ميزان حسناتك ..... حقاً مبدع

خالص احترامى

تم تعديل أغسطس 14, 2015 بواسطه خالد الرشيدى

[أبو عبدالإله]

أستاذي ياسر وضعت الكود وظهرت لي رسالة خطأ :

 

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

راجع المشاركة مرة أخرى ..كنت قد أضفت أسطر لتجنب الخطأ قبل أن تسأل

[خالد الرشيدى]

اخى الفاضل وبعد اذن استازى ياسر

يمكنك استخدام الكود التالى فهو اكثر اختصارا

Sub khaled()
 
 Application.ScreenUpdating = False
  
  Cells(Rows.Count, 4).End(xlUp).Offset(1, 0).Select
    
      Selection.EntireRow.Insert
    Range("D" & Selection.Row).FillDown
   
 Application.ScreenUpdating = True
   
End Sub

 

تم تعديل أغسطس 14, 2015 بواسطه خالد الرشيدى

[أبو عبدالإله]

جرب هذا التعديل .. حاول أن تبتعد عن دمج الخلايا لأنه يسبب مشاكل مع الأكواد

Sub khaled()
    Application.ScreenUpdating = False
        Cells(Rows.Count, 4).End(xlUp).Offset(1, 0).Select
        Rows(Selection.Row - 1).Copy
        Rows(Selection.Row).Insert Shift:=xlDown
        On Error Resume Next
        Rows(Selection.Row).SpecialCells(xlConstants).ClearContents
        On Error GoTo 0
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

 

اخى الفاضل وبعد اذن استازى ياسر

يمكنك استخدام الكود التالى فهو اكثر اختصارا

Sub khaled()
 
 Application.ScreenUpdating = False
  
  Cells(Rows.Count, 4).End(xlUp).Offset(1, 0).Select
    
      Selection.EntireRow.Insert
    Range("D" & Selection.Row).FillDown
   
 Application.ScreenUpdating = True
   
End Sub

 

 

 

أستاذ ياسر

أستاذ خالد 

قبلة على جبين كل واحد منكما 

 

تعجز الكلمات عن شكركما فعلا 

 

فقد أبدعتما وأجدتما  بتعديل الكود وأصبح يعمل بشكل ممتاز جدا وبالشكل المطلوب .

 

دمتما متألقين وأفخر بتواجدي في منتدى فيه أمثالكم