mohamed_omar

Sub create_a_sheet_if() Dim mhName As String mhName = Sheets("ورقة3").Range("a2").Value Application.ScreenUpdating = False On Error Resume Next Worksheets(mhName).Activate Application.ScreenUpdating = True End Sub

اول خطا هو عدم اقفال الحلقة الاولى for i = 1 to 5000 ثاني خطا هو اقفال الحلقة الثانية قبل اقفال جملة if التي هي بداخل حلقة for

قضية الاساسي 2022 اخر حاجة.xlsm

قضية الاساسي 2022 اخر حاجة.xlsm الكود المستخدم من نموذج الاستاذ: نموذج للأستاذ / hat شرح وتنصيب لكود تفقيط http://www.officena.net/ib/index.php?showtopic=45879#entry273104

ارجوا ان يكون هذا ما تريد قضية الاساسي 2022 - Copy.xlsm

بارك الله فيك استاذنا محي الدين

محاولة متواضعة ارجوا ان تكون مفيدة Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim lr As Long lr = sheet1.Range("a10000").End(xlUp).Row For i = 4 To lr If sheet1.Cells(i, 2).Value < sheet1.Range("b3") Then sheet1.Cells(i, 2).Interior.Color = vbRed Else sheet1.Cells(i, 2).Interior.Color = vbWhite End If Next For i = 4 To lr If sheet1.Cells(i, 3).Value < sheet1.Range("c3") Then sheet1.Cells(i, 3).Interior.Color = vbRed Else sheet1.Cells(i, 3).Interior.Color = vbWhite End If Next For i = 4 To lr If sheet1.Cells(i, 4).Value < sheet1.Range("d3") Then sheet1.Cells(i, 4).Interior.Color = vbRed Else sheet1.Cells(i, 4).Interior.Color = vbWhite End If Next For i = 4 To lr If sheet1.Cells(i, 5).Value < sheet1.Range("e3") Then sheet1.Cells(i, 5).Interior.Color = vbRed Else sheet1.Cells(i, 5).Interior.Color = vbWhite End If Next End Sub درجات طلبه.xlsm