علي عبد المنعم قام بنشر يونيو 29, 2017 قام بنشر يونيو 29, 2017 برجاء المساعدة في تعديل كود ترحيل نتيجة الدور الثاني.rar
أفضل إجابة ياسر خليل أبو البراء قام بنشر يونيو 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
سليم حاصبيا قام بنشر يونيو 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
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.