علي عبد المنعم قام بنشر يونيو 29, 2017 مشاركة قام بنشر يونيو 29, 2017 برجاء المساعدة في تعديل كود ترحيل نتيجة الدور الثاني.rar رابط هذا التعليق شارك More sharing options...
أفضل إجابة ياسر خليل أبو البراء قام بنشر يونيو 29, 2017 أفضل إجابة مشاركة قام بنشر يونيو 29, 2017 السلام عليكم جرب التعديل التالي عله يفي بالغرض Sub Test() Dim ws As Worksheet Dim sh As Worksheet Dim r As Long Dim m As Long Set ws = Sheets("تسجيل الدرجات") Set sh = Sheets("دور ثاني") m = 11 Application.ScreenUpdating = False For r = 11 To 307 Step 2 sh.Range("E" & r & ":CT" & r).ClearContents Next r For r = 8 To 306 If ws.Cells(r, 3) = "راسب" Then sh.Range("E" & m).Resize(1, 95).Value = ws.Range("D" & r).Resize(1, 95).Value m = m + 2 End If Next r Application.ScreenUpdating = True MsgBox ("الحمد لله تـــم الترحيل ") End Sub 1 رابط هذا التعليق شارك More sharing options...
سليم حاصبيا قام بنشر يونيو 29, 2017 مشاركة قام بنشر يونيو 29, 2017 ربما ينفع هذا الكود Option Explicit Sub Tarhil() Dim First, Sec As Worksheet Dim m, n, x As Long Set First = Sheets("تسجيل الدرجات") Set Sec = Sheets("دور ثاني") m = 11 Application.ScreenUpdating = False For n = 6 To 154 x = 2 * n - 1: Sec.Range("E" & x & ":CT" & x).ClearContents Next For n = 8 To x - 2 If First.Cells(n, 3) = "راسب" Then Sec.Range("E" & m).Resize(1, 95).Value = First.Range("D" & n).Resize(1, 95).Value m = m + 2 End If Next Application.ScreenUpdating = True MsgBox ("That Is All ") End Sub 1 رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
من فضلك سجل دخول لتتمكن من التعليق
ستتمكن من اضافه تعليقات بعد التسجيل
سجل دخولك الان