المطلوب اضافة لكود

[2saad]

اخي الكريم شكرا لرد حضرتك

عايز اكمل الكود بحيث عندما اضغط علي القائمة المنسدلة الموجودة في الخلية ( f8 )

واختار المادة

يتم ترحيل الدرجات من sheet1  الي sheet2 للمادة المختارة من  القائمة ويتم الفلترة علي حسب الفصل من القائمة المنسدلة

( E8)ويتم اللصق من خلية (رزان.xlsm I10 )

 

يعني يكون الترحيل بناء علي القائمة المنسدلة بتاعة الفصل والقائمة المنسدلة بتاعة المادة

ولكم جزيل الشكر

[محي الدين ابو البشر]

 تفضل

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
 Dim a
 Dim i&, r&
 Dim ws As Worksheet, sh As Worksheet
 Set ws = Sheet1: Set sh = Sheet2
 With ws
a = .Range(.Range("A10:G10"), .Range("A10:G10").End(xlDown))
 End With
    If Target.Address = "$F$8" Then
 r = Sheet1.Cells.Find(Target, , , 1).Column
       With CreateObject("scripting.dictionary")
        For i = 1 To UBound(a)
        If a(i, 1) = sh.Cells(8, 5) Then
                If Not .exists(a(i, 1)) Then
                .Add a(i, 1), a(i, r)
                Else
                .Item(a(i, 1)) = .Item(a(i, 1)) & "|" & a(i, r)
                 End If: End If
                 Next
                 a = Split(.items()(0), "|")
                
             With sh.Cells(10, 6)
       .Resize(Rows.Count - .Row + 1).ClearContents
       .Resize(UBound(a) + 1) = Application.Transpose(a)
   End
        End With
        End With
        End If
End Sub

 

رزان2.xlsm

[2saad]

هل من مجيب ؟

شكرا جزيلا لحضرتك وربنا يجعله في ميزان حسناتك