تعديل كود

[2saad]

إخواني الأعزاء بعد سلام الله عليكم ورحمة الله وبركاته

في الملف المرفق

محتاج عند الضغط علي زر  ( ترحيل الفرق ) الموجود في صفحة  ( class_room ) يتم ترحيل البيانات في الشيتات ( كي جي1 - كي جي2 - الصف الأول - الصف الثاني - الصف الثالث - الصف الرابع - الصف الخامس - الصف السادس ) من العمود B الي العمود S

يعني عايز اعدل في الكود

Tbl_student.rar

[محمد هشام.]

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

Sub Sheets_Arrays3()
    Dim lr&, LR2&, WSData As Worksheet
    Dim Dest As Worksheet: Set Dest = Sheets("class_room")
    
    LR2 = Dest.Cells(Dest.Rows.Count, "B").End(xlUp).Row
    If LR2 >= 2 Then Dest.Range("B2:S" & LR2).ClearContents

    Application.ScreenUpdating = False
    For Each WSData In Sheets(Array("كي جي1", "كي جي2", _
    "الصف الأول", "الصف الثاني", "الصف الثالث", "الصف الرابع", "الصف الخامس", "الصف السادس"))
        lr = WSData.Cells(WSData.Rows.Count, "B").End(xlUp).Row
        
        If lr >= 3 Then
            LR2 = Dest.Cells(Dest.Rows.Count, "B").End(xlUp).Row + 1
            Dest.Range("B" & LR2 & ":S" & (LR2 + lr - 3)).Value = WSData.Range("B3:S" & lr).Value
        End If
    Next WSData

    Application.ScreenUpdating = True
    MsgBox "تم ترحيل الفرق بنجاح", vbInformation
End Sub

 

[2saad]

شكرا جزيلا أخي الفاضل محمد وبارك الله فيك