اضافه صف تحت الصفوف في صفحات

[ناصر سعيد]

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

احبابنا في الله

في هذا الكود الرائع لصاحبه الاستاذ ياسر العربي  يمسح ثم ينسخ

نريد ان نلغي عمليه المسح ليتم النسخ بعد الصفوف الموجوده فعلا

لماذا ؟

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

جزى الله الذين يبتغون وجه الله بكل خير وبارك فيهم يارب

==============

ان شاء الله سارفق الكود والملف

[ناصر سعيد]

المرفق

 

تجـــــــــــــــــــــــــــــــــــــــربه - نسخة.rar

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

أليس الموضوع مكرر أم أن الطلب مختلف هنا في الموضوع؟؟!!

[ناصر سعيد]

الطلب مختلف تماما لان الكود الاول خاص بالمسح ثم اضافه صفوف

اما هذا الموضوع خاص باضافه صف او صفوف بدون مسح ماتم نسخه من صفوف

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

[خالد الذيابي]

السلام عليكم 

استاذ ياسر خليل أبو البراء ارجو منك المساعدة في تصميم ملف اكسيل 

[مسافر زاده الخيال]

أتوافق معك أستاذ ناصر فنحن في التعليم الفني أحيانا يسحب طالب الملف ويسجل نفسه في طلبة المنازل  ونريد ترحيله مع طلبة المنازل أوتوناتيكيا

[ناصر سعيد]

للرفع لننهي الاعمال على خير ان شاء الله

[ناصر سعيد]

هذا هو الكود الذي هداني به المحترم الاستاذ بن عليه حفظه الله ورعاه
وهو خاص بنسخ صفوف اسفل الصفوف المنسوخه

 'هذا الكود للمحترم ياسر العربي
 ' الهدف من الكود هو نسخ صف الى صفوف تحته بالعدد المطلوب
 'بدون مسح البيانات القديمه
 'تاريخ الانشاء 30/7/2017
 'تم التعديل بواسطه المحترم الخلوق بن عليه حاجي
'=*=*=*=*=*=*=*=*=*=*=*=*=*=*
Private Sub CommandButton1_Click()
    Dim sh As Worksheet, lr As Long, str As String
    If TextBox1.Text = Sheets("بيانات الطلبة").Range("F1") Then
        Me.Hide
        TextBox1.Text = ""
        MsgBox "كلمة المرور صحيحة و سيتم تنفيذ المطلوب"
        Application.ScreenUpdating = False
        Application.Calculation = xlCalculationManual
        'اذا كان عدد المتقدمين اقل من اتنين يتم ايقاف الكود ولا يكمل
        If Sheets("بيانات الطلبة").Range("Q1") < 2 Then
            Exit Sub
        End If
        '=*=*=*=*=*=*
 For Each sh In Sheets(Array("بيانات الطلبة", "إنجاز1", "تحريرى ف 1", "تحريرى ف 2", "أعمال السنة", "كشف ناجح", "الحاله", "كنترول شيت", "رصد الترم الثانى", "كنترول شيت (2)", "رصد الترم الأول", "كشف الدور الثاني"))

'---------------------------------------------------------------------------------------
            'lr = sh.Range("B" & sh.Range("b10000").End(xlUp).Row).Row
            lr = sh.Range("A" & sh.Range("A10000").End(xlUp).Row).Row
'---------------------------------------------------------------------------------------
            
            sh.Activate
            
            '========================
            ' str المتغير دا يتم تخزين اسم العمود الاخير فيه للعمل عليه
            'يتم الذهاب الى اخر عمود بالاعتماد على الصف السادس  ويتم استخلاص اسم العمود من اسم النطاق
            str = Split(sh.Range("HH9").End(xlToLeft).Address, "$")(1)
            
            '   نسخ الصف السابع لكل شيت من حيث عدد الاعمدة الى العدد المحدد بعدد المتقدمين
'---------------------------------------------------------------------------------------
            Set Rng = Range("A" & lr + IIf(lr = 9, 0, 1) & ":" & str & ['بيانات الطلبة'!Q1] + lr - IIf(lr = 9, 1, 0))
               sh.Range("A9:" & str & 9).Copy Destination:=Rng
'---------------------------------------------------------------------------------------
        Next
      Sheets("بيانات الطلبة").Select
    Range("A4").Select

        Application.Calculation = xlCalculationAutomatic
        Application.ScreenUpdating = True
        Unload Me
    Else
        MsgBox "عفوا كلمة المرور خاطئة و لن يتم تنفيذ المطلوب"
        TextBox1.Text = ""
        TextBox1.SetFocus
    End If
End Sub

Private Sub UserForm_Click()

End Sub
'===================================

 

تم تعديل أغسطس 9, 2017 بواسطه ناصر سعيد
التنسيقات