استخراج قائمة الأساتذة

[مجاهد2013]

السلام عليكم 
في الملف المرفق أريد استخراج أساتذة كل قسم على حدى من الورقة الأم  EMPL PROF و وضعه في الورقة المسماة ISNAD حسب النموذج المرفق على أن تكون النتائج كما في الصورة 

Classeur2.xlsx

[Jasmin]

لم أفهم الجدول المستخرج - ربما الرمكز مبهمة ولكن أيضا عندينموذج ممكن تشوف الformula
VLookUp_Jinane.xls

[مجاهد2013]

شكرا Jasmin لقد اطلعت على الموضوع لكن المقصود هو استخراج قائمة الاساتذة لكل قسم حسب مادة التدريس 

الاقسام موجودة في الصف 2

[lionheart]

Sub Test()
    Dim ws As Worksheet, sh As Worksheet, r As Range, d As Object, i As Long
    Application.ScreenUpdating = False
        Set ws = Sheets(1): Set sh = Sheets(2)
        Set d = CreateObject("Scripting.Dictionary")
        With ws
            Set r = .Range("B4:BF" & .Cells(Rows.Count, 3).End(xlUp).Row)
            For Each r In Intersect(r, r.Offset(1, 2))
                If r.Value <> "" Then
                    i = r.Row
                    d(.Cells(i, 2) & .Cells(i, 3) & r) = Array(.Cells(i, 2), .Cells(i, 3), r)
                End If
            Next r
        End With
        With sh
            .Range("C3:BE15").ClearContents
            .Range("BK1").Resize(d.Count, 3) = Application.Transpose(Application.Transpose(d.Items))
            .Range("BN1:BN" & d.Count).Formula = "=BL1&BM1"
            With .Range("C3:BE15")
                .Formula = "=IFERROR(INDEX($BK:$BK,MATCH($B3&C$2,$BN:$BN,0)),"""")"
                .Value = .Value
            End With
            .Columns("BK:BN").ClearContents
        End With
    Application.ScreenUpdating = True
End Sub

 

[مجاهد2013]

ألف شكرا أستاذنا مع تحياتي