اقتباس:
المشاركة الأصلية كتبت بواسطة سفنكس1
شكرا جزيلا على هذا الشرح الرائع جزاكم الله كل خير
لى طلب لو سمحتم هل يمكن فصل الطلاب الراسبين عن الطلاب الناجحين فى ورقة منفصلة
|
استخدم الكود التالي
الكود لعملاق من عمالقة الإكسيل هو الأستاذ : عبدالله باقشير اليمني
كود PHP:
Sub Kh_Start()
On Error Resume Next
Dim M As Integer, N As Integer, X As Integer, R As Integer
Sheet8.Range("A11:DG1010").Clear
Sheet5.Range("A11:DG1010").Clear
M = 11 ' أول صف لشيت الناجحين
N = 11 ' أول صف لشيت الراسبين
Application.ScreenUpdating = False
With Sheet10
X = .Range("A" & .Rows.Count).End(xlUp).Row
For R = 1 To 1010
If .Range("DT" & R) = "ناجح" Then
.Range("A" & R).Resize(1, 110).Copy
KH_Paste Sheet8, M
M = M + 1
ElseIf .Range("DT" & R) = "راسب" Then
.Range("A" & R).Resize(1, 110).Copy
KH_Paste Sheet5, N
N = N + 1
End If
Next
End With
Application.ScreenUpdating = True
MsgBox "Êã ÊÑÍíá " & M - 11 & " تم الترحيل " & Chr(10) & Chr(10) & "الحمد لله " & N - 11 & " ØÇáÈ áå ÏæÑ ËÇä Åáì ÔíÊ ÇáÑÇÓÈíä ", vbMsgBoxRight, "ÇáÍãÏááå ÑÈ ÇáÚÇáãíä"
End Sub
========================================================
Sub KH_Paste(MySheet As Worksheet, KRow As Integer)
On Error Resume Next
With MySheet
.Range("A" & KRow).PasteSpecial xlPasteValues
.Range("A" & KRow).PasteSpecial xlPasteFormats
.Range("A" & KRow) = KRow - 9
End With
Application.CutCopyMode = False
End Sub
04-05-2012, 07:15 PM
العرض المتطور
