فصل

[waledms]

الأخوة الأعزاء ........... السلام عليكم ورحمة الله وبركاته........... الشيت المرفق به درجات المطلوب فصل الناجح عن الراسب فى شيتين منفصلين ( ناجح1ودورثان2)

2017شيت مدرستى - الصف الخامس-.rar

[waledms]

لم أجد الحل فى المحتوى المشابه

[ابراهيم الحداد]

السلام عليكم ورحمة الله

استخدم هذا الكود

Sub Sparate_Result()
Dim ws As Worksheet, Sh1 As Worksheet, Sh2 As Worksheet
Dim Succ As String, Fail As String
Dim Arr As Variant, Temp As Variant
Dim LR As Long, i As Long, j As Long, p As Long, q As Long
Application.ScreenUpdating = False
Set ws = Sheets("نتيجة آخر العام ")
Set Sh1 = Sheets("ناجح1")
Set Sh2 = Sheets("دور ثان2")
Sh1.Range("H6:AI110").ClearContents
Sh1.Range("H6:AI110").ClearContents
Succ = "ناجح"
Fail = "دور ثان"
Arr = ws.Range("B6:AI110").Value
ReDim Temp(1 To UBound(Arr, 1), 1 To UBound(Arr, 2))
For i = 1 To UBound(Arr, 1)
If Arr(i, 33) = Succ Then
p = p + 1
For j = 1 To UBound(Arr, 2)
Temp(p, j) = Arr(i, j)
Next
End If
Next
If p > 0 Then Sh1.Range("B6").Resize(p, UBound(Temp, 2)).Value = Temp
ReDim Temp(1 To UBound(Arr, 1), 1 To UBound(Arr, 2))
For i = 1 To UBound(Arr, 1)
If Arr(i, 33) = Fail Then
q = q + 1
For j = 1 To UBound(Arr, 2)
Temp(q, j) = Arr(i, j)
Next
End If
Next
If q > 0 Then Sh2.Range("B6").Resize(q, UBound(Temp, 2)).Value = Temp
Application.ScreenUpdating = True
End Sub

 

[waledms]

جزاك الله خيراً .....