طلب كود لاستدعاء الغائبين

[سيد الأكـرت]

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

الغياب.xls

[lionheart]

Sub Committees_Absence()
    Rem Worksheets
    Dim wsData As Worksheet, wsCommittee As Worksheet
    Set wsData = ThisWorkbook.Worksheets(1)
    Set wsCommittee = ThisWorkbook.Worksheets(2)
    
    Rem Determine Subject Column
    Dim xSubject, iColSubject As Long
    xSubject = Application.Match(wsCommittee.Range("D8").Value, wsData.Range("F6:M6"), 0)
    If Not IsError(xSubject) Then
        iColSubject = xSubject + 5
    Else
        MsgBox "No Such A Subject", vbExclamation: Exit Sub
    End If
    
    Rem Last Row In Data Worksheet
    Dim lrData As Long
    lrData = wsData.Cells(Rows.Count, "B").End(xlUp).Row
    
    Rem Absence Results In An Array
    Dim r As Long, n As Long
    ReDim aresults(1 To 1000, 1 To 4)
    For r = 7 To lrData
        If wsData.Cells(r, iColSubject).Value = Chr(219) Then
            n = n + 1
            aresults(n, 1) = wsData.Cells(r, 5).Value   'Committee
            aresults(n, 2) = wsData.Cells(r, 3).Value   'Grade
            aresults(n, 3) = wsData.Cells(r, 2).Value   'Student Name
            aresults(n, 4) = wsData.Cells(r, 4).Value   'Seat Number
        End If
    Next r
    
    Rem Populate Results
    Dim iRow As Long
    With wsCommittee
        .Range("A11:F1000").ClearContents
        iRow = 11
        If n > 0 Then .Range("A" & iRow).Resize(n, UBound(aresults, 2)).Value = aresults
    End With
End Sub

 

[سيد الأكـرت]

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

[سيد الأكـرت]

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

غياب2.xls