رغم أن المنطق غير واضح بناءً على أول مشاركة .. جرب التعديل التالي عله يفي بالغرض إن شاء الله
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