وعليكم السلام
يرجى عدم تغيير حجم الخط ، اكتب المشاركة بالشكل الطبيعي بحيث يكون السؤال واضح
جرب الكود التالي عله يفي بالغرض (قم بدراسة الكود بشكل جيد واسأل في الجزئيات بحيث تتمكن من التعديل على الكود بنفسك وتتعلم وتستفيد وتفيد الآخرين)

Sub Test()
    Dim x, ws As Worksheet, sh As Worksheet, sGrade As String, iMark As Integer, m As Long, r As Long, c As Long, cl As Long
    Application.ScreenUpdating = False
    Set ws = ThisWorkbook.Worksheets("BD")
    Set sh = ThisWorkbook.Worksheets("CV")
    m = ws.Cells(Rows.Count, 1).End(xlUp).Row
    For r = 3 To m
        x = Application.Match(ws.Cells(r, 1).Value, sh.Columns(1), 0)
        If IsError(x) Then GoTo Skipper
        sh.Range("C" & x + 1).Resize(10, 4).ClearContents
        For c = 2 To 11
            sGrade = ws.Cells(r, c).Value
            Select Case sGrade
                Case "A": iMark = 8: cl = 3
                Case "B": iMark = 7: cl = 4
                Case "C": iMark = 4: cl = 5
                Case "D": iMark = 1: cl = 6
                Case Else: GoTo nextV
            End Select
            sh.Cells(x + c - 1, cl).Value = iMark
nextV:
        Next c
Skipper:
    Next r
    Application.ScreenUpdating = True
    MsgBox "Done", 64, "YasserKhalil Excel-Egy"
End Sub

جزاكم الله خيرا و بارك الله فيكم الكود 100/100

وجزيت خيراً أخي الكريم بمثل ما دعوت لي والحمد لله أن تم المطلوب على خير.

بارك الله فيكم و جزاكم الله خيرا
لقد ظهرت لي مشكلة اخرى و هي
اذا اردت أن أعطي قيمة لمثلا "A" و لكن لعمود أخر مثلا
Case "A": iMark = 2: cl = 4
أو اي عمود أخر مثلا العمود 7

كيف استطيع اضافة هذا السطر مع الكوذ الي عملته انت
و جزاكم الله خيرا
هذا قطعة من الكود تاعك

Case "A": iMark = 8: cl = 3
                Case "B": iMark = 7: cl = 4
                Case "C": iMark = 4: cl = 5
                Case "D": iMark = 1: cl = 6

Case "A": iMark = 8: cl = 3 Case "B": iMark = 7: cl = 4 Case "C": iMark = 4: cl = 5 Case "D": iMark = 1: cl = 6

في هذا السطر على سبيل المثال

Case "A": iMark = 8

التقدير المستخدم هو A والدرجة المقابلة لهذا التقددير هي 8 ويتم تحديد العمود المراد وضع الدرجة فيه بناءً على قيمة المتغير المسمى cl بمعنى لو أردت وضع الدرجة في العمود الرابع في الورقة الهدف فقم بتعيين القيمة 4 للمتغير المسمى cl إلى 4

بارك الله فيك و جزاك الله خيرا
انا اردت ان اطرح السؤال كالتالي
هل ممكن ان تاخذ A قيمتين ولكن بشرط if
مثلا اذا كانت قيمة الخلية هي A فستكون قيمتها 8 في العمود 3 و قيمتها 1 في العمود 7

Case "A": iMark = 8: cl = 3 Case "A": iMark = 1: cl=7

و جزاكم الله خيرا


Case "A": iMark = 8: cl = 3 Case "A": iMark = 1: cl=7

النقطة الأخيرة غير واضحة .. حاول توضحها بصورة
ويمكنك استخدام جملة If داخل جملة Select إذا كان هناك تفريعات وشروط أخرى.

السلام عليكم و رحمة الله و بركاته
اسمحلي الأستاذ ياسر اتعبتك معي
اريد بارك الله ان أجعل لـ "A" قيمتين الأولى 8 و يضعها في cl=3 و الثانية 1 و يضعها في cl=7

Case "A": iMark = 8: cl = 3
Case "A": iMark = 1: cl = 7
لا أعلم كيف أدخل if الشرطية على select case
أنا قصدي كما نفعل مع if then
و التوضيح في الملف المرفوع

رغم أن المنطق غير واضح بناءً على أول مشاركة .. جرب التعديل التالي عله يفي بالغرض إن شاء الله

Sub Test()
    Dim x, ws As Worksheet, sh As Worksheet, sGrade As String, iMark As Integer, m As Long, r As Long, c As Long, cl As Long
    Application.ScreenUpdating = False
    Set ws = ThisWorkbook.Worksheets("BD")
    Set sh = ThisWorkbook.Worksheets("CV")
    m = ws.Cells(Rows.Count, 1).End(xlUp).Row
    For r = 3 To m
        x = Application.Match(ws.Cells(r, 1).Value, sh.Columns(1), 0)
        If IsError(x) Then GoTo Skipper
        sh.Range("C" & x + 1).Resize(10, 5).ClearContents
        For c = 2 To 11
            sGrade = ws.Cells(r, c).Value
            Select Case sGrade
                Case "A": iMark = 8: cl = 3
                Case "B": iMark = 7: cl = 4
                Case "C": iMark = 4: cl = 5
                Case "D": iMark = 1: cl = 6
                Case Else: GoTo nextV
            End Select
            sh.Cells(x + c - 1, cl).Value = iMark
            If sGrade = "A" Then sh.Cells(x + c - 1, 7).Value = 1
nextV:
        Next c
Skipper:
    Next r
    Application.ScreenUpdating = True
    MsgBox "Done", 64, "YasserKhalil Excel-Egy"
End Sub

بارك الله فيك و جزاك الله خيرا هذا هو المطلوب حفظك الله و رعاك وكل الاساتذة لست ادري كيف اوفي حقكم الا ان اقول جعلها الله لكم في ميزان حسناتكم و ادخلكم جنته و كل المسلمين

وجزيت خيراً أخي الكريم بمثل ما دعوت لنا وزيادة والحمد لله أن تم المطلوب على خير.