إجمالي مرات مشاهدة الصفحة

الأحد، 24 أبريل 2016

نسخ صف محدد قبل كل الصفوف Copy Specific Row Before Each Row

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

إليكم كود يقوم بنسخ صف معين قبل كل الصفوف ، أي يقوم الكود بإدراج هذا الصف قبل كل الصفوف حسب الرغبة.

بفرض أن لديك ورقة عمل بها جدول بهذا الشكل :
والمطلوب أن يتم نسخ النطاق A1:D1 ويتم لصقه في كل الصفوف ، ليصبح بهذا الشكل :

يعتمد الكود على عمل حلقة تكرارية معكوسة أي أنها تبدأ من آخر صف بالنطاق في العمود الأول إلى الصف الثالث ، حيث يتم مع كل حلقة نسخ النطاق A1:D1 ، ثم إدراج النطاق المنسوخ قبل الصف الهدف.

وإليكم الكود المستخدم لتحقيق المطلوب ، يوضع الكود في موديول عادي Standard Module :

Sub Copy_Specific_Row()
    Dim I As Long
    
    Application.ScreenUpdating = False
        For I = Cells(Rows.Count, 1).End(xlUp).Row - 1 To 3 Step -1
            Range("A1:D1").Copy
            Range(Cells(I, "A"), Cells(I, "D")).Insert Shift:=xlDown
        Next I
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

إعداد / ياسر خليل أبو البراء

هناك 5 تعليقات:

  1. أخي الكريم مجدي سالم
    مشكور على المرور العطر .. ولكن ماذا تعني ما في حيلة؟
    أتعنى أن الكود مباشر ولا يوجد حيلة فيه؟ أم أن هذا مصطلح لديكم يعني أمراً آخر؟

    ردحذف
  2. شكرا لك اخي العزيز ياسر وفقك الله لكل خير

    ردحذف
  3. مشكور أخي الكريم على مرورك العطر بالمدونة

    ردحذف
  4. eToro صفقات التداول المفتوحة في 227,585,248

    انضم إلى مسيرة النجاح اتصل بأكثر من 4 ملايين متداول ومستثمر من 170 دولة

    ردحذف