كود ترحيل مادة

[2saad]

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

محتاج من حضراتكم كود

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

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

يتم الترحيل الدرجات من sheet1  الي sheet2 للمادة المختارة من  القائمة

ويتم اللصق بداية من خلية ( f10 )

ولكم جزيل الشكررزان.xlsx

[lionheart]

Peace be upon you. Put the following code in worksheet module (Sheet2)

Right-click on Sheet2 > View Code > Paste the following macro

Private Sub Worksheet_Change(ByVal Target As Range)
    Const sRow As Long = 9, sTargetCell As String = "F10"
    Dim x, a, ws As Worksheet, sh As Worksheet, lr As Long
    If Target.Address = "$F$8" Then
        Set ws = Sheet1: Set sh = Sheet2
        With sh.Range(sTargetCell)
            .Resize(Rows.Count - .Row + 1).ClearContents
        End With
        If Target.Value = Empty Then Exit Sub
        lr = ws.Cells(Rows.Count, 1).End(xlUp).Row
        If lr < sRow + 1 Then MsgBox "No Data In Sheet1", vbExclamation: Exit Sub
        x = Application.Match(Target.Value, ws.Rows(sRow), 0)
        If IsError(x) Then MsgBox "Subject Not Found In Sheet1", vbExclamation: Exit Sub
        a = ws.Range(ws.Cells(sRow + 1, x), ws.Cells(lr, x)).Value
        sh.Range(sTargetCell).Resize(UBound(a, 1), UBound(a, 2)).Value = a
    End If
End Sub

 

تم تعديل فبراير 7, 2023 بواسطه lionheart

[2saad]

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

 

[2saad]

أخي الكريم ممكن

تكمل جميلك

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

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

 

[lionheart]

Please open new topic and give more details