الكود بالكامل كالتالى
Dim Z As Integer, A As Integer, B As Integer
Sheets("15").Range("A11:DZ5000").ClearContents
Sheets("16").Range("A11:DZ5000").ClearContents
A = 11: B = 11
Application.ScreenUpdating = False
For Z = 11 To 5000
If Cells(Z, 1) = "ناجحة" Then
Range("A" & Z).Resize(1, 33).Copy
Sheets("15").Range("A" & A).PasteSpecial xlPasteValues
Application.CutCopyMode = False
'
A = A + 1
End If
If Cells(Z, 1) = "لها دور ثان" Then
Range("A" & Z).Resize(1, 33).Copy
Sheets("16").Range("A" & B).PasteSpecial xlPasteValues
Application.CutCopyMode = False
B = B + 1
End If
Next
For Y = 16 To 17
Sheets(Y).[B11] = 1
rrw = Sheets(Y).[B3000].End(xlUp).Row
For Each cc In Sheets(Y).Range("B12:B" & rrw)
cc.Value = cc.Offset(-1, 0) + 1
Next cc
Next Y
MsgBox ("الحمد لله تـــم ترحيل الطالبات كل إلى نتيجتها طبقاً للإحصاء التالى ")
For x = 16 To 17
Y = Sheets(x).[B3000].End(xlUp).Row - 10
mssg = mssg & Chr(10) & Format(Y, "00") & " Students to Sheet : " & x
Next x
MsgBox (" تم ترحيل عدد" & mssg)
Range("A1").Select
Application.ScreenUpdating = True
End Sub