سلمت يمينك استاذ عبدالله
كنت قد عدلت على الكود السابق ولكن شتان
Sub Abu_Ahmed()
Dim cl As Range, cel As Range
For Each cel In [C9:AG17]
If IsNumeric(cel) Then cel = ""
Next
For i = 4 To [AK1000].End(xlUp).Row
For Each cl In [A9:A17]
If cl = Cells(i, 37) Then
T = Cells(i, 38): K = Cells(i, 39)
For ii = 3 To 33
If Cells(7, ii) = "s" Then
If Not IsNumeric(Cells(cl.Row, ii)) Then GoTo 1
If T = 1 Then Cells(cl.Row, ii) = 1: T = 0: GoTo 1
If T >= 2 Then Cells(cl.Row, ii) = 2: T = T - 2
End If
If Cells(7, ii) = "H" Then
If K < 8 Then Cells(cl.Row, ii) = K: K = 0: GoTo 1
If K >= 8 Then Cells(cl.Row, ii) = 8: K = K - 8
End If
1 Next
End If
Next
Next
End Sub