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

السلام عليكم ورحمة الله استبدل الكود السابق بهذا الكود Private Sub Workbook_Open() For R = 1 To 100 x = Range("A" & R).Address If Range("A" & R) = 1 Then MsgBox "الخلية" & x & "= TRUE" Else MsgBox "الخلية" & x & "=FALSE" End If Next End Sub

السلام عليكم ورحمة الله تم الوصول الى الحل وتأخر الرد بسبب انقطاع الانترنت فى حالة وجود نيجة خطأ فى خلايا المبلغ يرجى الضغط على CRTL + SHIFI + ENTER اليك الملف test1.rar

بارك الله فيك جزاك الله خيرا

السلام عليكم ورحمة الله تفضل اخى الكريم الطلاب.rar

السلام عليكم ورحمة الله اعتقد هذا هو ماتقصده test1.rar

السلام عليكم ورحمة الله اتمنى من الله ان يكون هذا هو ماتقصده اليك الملف test1.rar

السلام عليكم ورحمة الله اكتب فى الخلية "K2" المرتبة المراد البحث عنها وفى الخلية "L2 " الدرجة المرقى لها ساعتها ستظهر النتيجة المطلوبة فى الخلية "M2 " مباشرة

السلام عليكم ورحمة الله اكتب هذه المعادلة فى الخلية "M2 " =SUMIFS($C$2:$C$151;$A$2:$A$151;$K$2;$B$2:$B$151;$L$2)

السلام عليكم ورحمة الله استبدل الكود السابق بهذا الكود Sub Trans_Cod() m = 3 Dim Arr As Variant, C As Range LS = Sheet2.Range("A" & Rows.Count).End(xlUp).Row Sheet2.Range("A4:B" & LS).ClearContents Arr = Array("D", "F", "H", "J", "L", "N") For i = LBound(Arr) To UBound(Arr) Set C = Sheet1.Columns(Arr(i)) LR = Sheet1.Cells(Rows.Count, C.Column).End(xlUp).Row For R = 5 To LR If Not IsEmpty(Sheet1.Cells(R, C.Column)) Then m = m + 1 With Sheet2 .Range("B" & m) = Sheet1.Cells(R, C.Column) .Range("A" & m) = Sheet1.Cells(R, C.Column).Offset(0, 1) End With End If Next Next End Sub

السلام عليكم ورحمة الله انسخ هذا الكود وخصص له زر Sub Trans_Cod() m = 3 Dim Arr As Variant, C As Range Arr = Array("D", "F", "H", "J", "L", "N") For i = LBound(Arr) To UBound(Arr) Set C = Sheet1.Columns(Arr(i)) LR = Sheet1.Cells(Rows.Count, C.Column).End(xlUp).Row For R = 5 To LR If Not IsEmpty(Sheet1.Cells(R, C.Column)) Then m = m + 1 Range("B" & m) = Sheet1.Cells(R, C.Column) Range("A" & m) = Sheet1.Cells(R, C.Column).Offset(0, 1) End If Next Next End Sub

السلام عليكم ورحمة الله تفضل 2.rar

السلام عليكم ورحمة الله تفضل New Microsoft Excel Worksheet.rar

السلام عليكم ورحمة الله ارجو ان يكون هذا هو طلبك 1.rar

السلام عليكم ورحمة الله خصص الخلية "I4" لكتابة الاسم المطلوب البحث عنه وانسخ هذا الكود والصقه فى موديول جديد وخصص له زر Sub Selecting_Name() For R = 5 To 100 If Cells(R, "B") = Range("I4") Then Cells(R, "B").Select End If Next End Sub

السلام عليكم ورحمة الله تفضل مجموع بين تاريخين.rar

السلام عليكم ورحمة الله تفضل اخى الكريم قطع غيار بعد الخصم.rar

السلام عليكم ورحمة الله تفضل ...... عذرا على التأخير مجموع بين تاريخين.rar

السلام عليكم ورحمة الله انسخ هذا الكود و الصقه فى thisworkbook Private Sub Workbook_Open() ActiveSheet.Visible = False UserForm1.Show End Sub

السلام عليكم ورحمة الله انسخ هذا الكود والصقه فى حدث ورقة احصائيات وسيعمل معك بدون زر Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address <> "$C$1" And Target.Address <> "$C$2" Then Exit Sub Range("A5:H100").ClearContents m = 4 LR = Sheet1.Cells(Rows.Count, "I").End(xlUp).Row For R = 2 To LR If Sheet1.Cells(R, "I") >= Range("C1") And Sheet1.Cells(R, "I") <= Range("C2") Then m = m + 1 Range("A" & m) = Sheet1.Cells(R, "I") Range("B" & m) = Sheet1.Cells(R, "C") Range("C" & m) = Sheet1.Cells(R, "D") Range("D" & m) = Sheet1.Cells(R, "J") Range("E" & m) = Sheet1.Cells(R, "L") Range("F" & m) = Sheet1.Cells(R, "M") Range("G" & m) = Sheet1.Cells(R, "N") Range("H" & m) = Sheet1.Cells(R, "O") End If Next End Sub

السلام عليكم ورحمة الله اكتب هذه المعادلة فى الخلية "H2 " =IFERROR(INDEX($D$41:$Q$41;1;MATCH(TODAY();$D$5:$Q$5;0));"")

السلام عليكم ورحمة الله البحث يتم عن طريق كود الموظف حتى يعمل الكود بكفاءة

السلام عليكم ورحمة الله تم التعديل تفضل مرتبات.rar

السلام عليكم ورحمة الله تفضل مرتبات.rar

استبدل هذا الجزء Sheets("Programmation").Select Range("A2:I1105").Select Selection.ClearContents Sheets("Enregistrement").Select '''''''''''''''''''''''''''''''''''''' lr = Cells(Rows.Count, 1).End(xlUp).Row For r = 8 To lr If Cells(r, 8).Value = Empty Then GoTo 2 If Cells(r, 8).Value = "ok" Then Range(Cells(r, 1), Cells(r, 9)).Copy y = ThisWorkbook.Worksheets("Programmation").Cells(Rows.Count, 1).End(xlUp).Row + 1 ThisWorkbook.Worksheets("Programmation").Range("a" & y).PasteSpecial xlPasteValues End If بهذا الجزء m = 7 Sheets("Programmation").Select Range("A2:I1105").Select Selection.ClearContents Sheets("Enregistrement").Select '''''''''''''''''''''''''''''''''''''' lr = Cells(Rows.Count, 1).End(xlUp).Row For r = 8 To lr If Cells(r, 8).Value = Empty Then GoTo 2 If Cells(r, 8).Value = "ok" Then m = m + 1 Range(Cells(r, 1), Cells(r, 9)).Copy ThisWorkbook.Worksheets("Programmation").Range("a" & m).PasteSpecial xlPasteValues End If

السلام عليكم ورحمة الله انسخ هذا الكود وضعه فى موديول ثم انشئ ورقة عمل جديدة وسمها "تذكير" ثم خصص زر لهذا الكود Sub Remember() Range("A11:Z500").ClearContents Dim sh As Worksheet For Each sh In ThisWorkbook.Worksheets For R = 11 To 100 If sh.Name <> "اسماء العملاء" Or sh.Name <> "اقفال" Or sh.Name <> "تذكير" Then LR = Range("M" & Rows.Count).End(xlUp).Row + 1 If sh.Range("M" & R) = Date Then sh.Range("B" & R & ":Z" & R).Copy Range("B" & LR).PasteSpecial xlPasteValues Range("B" & LR).PasteSpecial xlPasteFormats Range("A" & LR) = LR - 10 End If End If Application.CutCopyMode = False Next Next End Sub