عبدالله باقشير

السلام عليكم اخي قصي عفوا اخي سارد عليك عند فراغي من بعض الاعمال الخاصة الموضوع على بالي لا تقلق

عمل رائع جدا جدا سلمت يداك و

السلام عليكم

الاخ الحبيب / زياد علي

بالنسبة للسؤال الثاني استخدم المعادلة التالية: =IF(A4>=600;A4*0;IF(A4>=500;(600-A4)*2;IF(A4>=360;700-A4;A4*1)))

السلام عليكم اخي الحبيب ابو اسامة ------حفظه ربي انت الذي تستحق الشكر والثناء تقبل تحياتي و تقديري

السلام عليكم في حالة الارقام استخدم value لتحويل النص الى رقم تفضل المرفق 111.rar

السلام عليكم بعد اذن اخي الفاضل ابواسامة واخي الفاضل سالم بعض التعديلات على الكود لعله يفي بالغرض الدوائر لا ترسم الا على المعدل فقط للجدولين في ورقة3 ________312.zip

السلام عليكم جمعة مباركة اخي ممكن تعمل صيغة واحدة فقط مكونة من جميع الصيغ المفردة في الخلايا التي لها علاقة بالصيغة ولكن انا جعلتها كذلك لتبسيط فهمها وعلى ما اذكر فقد عملناها من سابق

السلام عليكم استخدم في الكود بدلا من المسح الكلي في هذه الجزئية: Sheets("Sec-exam").Range("A14:BS2000").Clear مسح جزئي Sheets("Sec-exam").Range("A14:BS2000").ClearContents الاخ KEMAS الكود اخي عبارة عن نسخ بيانات في اعمدة معينة Range("A" & R).Range("A1:D1,F1:BJ1,BS1").Copy بشرط في عمود معين If Cells(R, 62) <> "دون المستوى" Then ولصق خاص PasteSpecial القيم xlPasteValues الفورمات xlPasteFormats جرب تسجل ماكرو لنسخ خلايا معينة ثم اعمل لصق خاص للقيم ثم للفورمات وانظر الى الكود ودمتم

السلام عليكم تفضل المرفق ______________.rar

السلام عليكم اسم الورقة نص يكتب بين علامتي تنصيص تفضل المرفق __________________________.rar

السلام عليكم لاظهار كافة الصيغ بالطريقة التي ذكرت في الورقة اضغط CTRL+` (العلامة النطقية)، أو في القائمة أدوات، أشر إلى تدقيق الصيغة، ثم انقر فوق وضع تدقيق الصيغة. ونفس الطريقة لعكس العملية. =========================================== ولكن ماتريده مخصص بعمود معين استخدم الكود التالي: Sub ماكرو1() For R = 2 To 6 Cells(R, 4).FormulaR1C1 = "'" & Cells(R, 3).Formula Next End Sub

السلام عليكم اذا تريد عمل ارتباط لخلية الحسم في ورقة2 اعمل نسخ لخلية الحسم في ورقة1 واذهب الى الخلية التي تريد نقل الارتباط فيها في ورقة2 واضغط زر السهم بجانب الزر لصق من القائمة اختر لصق ارتباط =Sheet1!$B$12

السلام عليكم الاخ الفاضل يوسف---------------حفظه الله في كود فتح الشيتات المخفية لم تغير اسم الصفحة الرئيسية في الكود مفروض يرجع الكود الى الصفحة الرئيسية وفي الكود اسم الصفحة الرئيسية main كذا لن تعمل هذه الجزئية من الكود غير الاسم main الى اسم الصفحة الرئيسية خاصتك في الملف

السلام عليكم استخدم هذا الكود في كود الورقة التي تريد اغلاقها ويمكنك تغيير كلمة المرور لكل ورقة حسب ماتريد Private Sub Worksheet_Activate() On Error Resume Next Dim XX As String, S As String Dim K As Integer, N As Integer Me.Columns.Hidden = True For K = 1 To 3 XX = InputBox(Prompt:="فضلا ادخل كلمة المرور", Title:="المحاولة رقم:" & K) If XX = "" Then Sheets("Main").Select Exit Sub ElseIf XX <> "kh" Then N = 3 - K If N = 0 Then S = "" Else S = "متبقي عدد " & N & " محاولة" MsgBox "كلمة المرور ليست صحيحة" & Chr(13) & Chr(13) & S, vbCritical + vbMsgBoxRtlReading + vbMsgBoxRight, "عفواً" Else Exit For End If Next K If K = 4 Then Sheets("Main").Select Exit Sub Else Me.Columns.Hidden = False End If On Error GoTo 0 End Sub في المرفق تم استخدامه في الورقة b و الورقة d تفضل المرفق aman.rar

السلام عليكم في المرفق كود لترحيل دور ثاني بتجاوز صف وعملية النسخ تتم للاعمدة المطلوبة فقط Sub دور_ثاني() Dim R As Integer, N As Integer Application.ScreenUpdating = False Sheets("Sec-exam").Range("A14:BS2000").Clear N = 13 ' الصفوف الخارجةعن البيانات اعلى الورقة For R = 14 To 113 If Cells(R, 62) = "دون المستوى" Then N = N + 2 Range("A" & R).Range("A1:D1,F1:BJ1,BS1").Copy With Sheets("Sec-exam") .Range("A" & N).PasteSpecial xlPasteValues .Range("A" & N).PasteSpecial xlPasteFormats .Range("A" & N) = (N - 13) / 2 End With Application.CutCopyMode = False End If Next MsgBox "تم ترحيل " & (N - 13) / 2, vbMsgBoxRight, "الحمد لله" Application.ScreenUpdating = True End Sub ========================================= كود لترحيل الناجحين بدون تجاوز صفوف وعملية النسخ تتم للاعمدة المطلوبة فقط Sub ناجح() Dim R As Integer, N As Integer Application.ScreenUpdating = False Sheets("Success").Range("A14:BS2000").Clear N = 13 ' الصفوف الخارجةعن البيانات اعلى الورقة For R = 14 To 113 If Cells(R, 62) <> "دون المستوى" Then N = N + 1 Range("A" & R).Range("A1:D1,F1:BJ1,BS1").Copy With Sheets("Success") .Range("A" & N).PasteSpecial xlPasteValues .Range("A" & N).PasteSpecial xlPasteFormats .Range("A" & N) = N - 13 End With Application.CutCopyMode = False End If Next MsgBox "تم ترحيل " & N - 13, vbMsgBoxRight, "الحمد لله" Application.ScreenUpdating = True End Sub ودمتم في حفظ الله ____________.zip

السلام عليكم الاخ قصي خلينا في الواد الغائب قولك في كل المواد الخانات الاربعة تقصد المواد اللي تحسب كدور ثاني ام كل المواد؟؟؟؟ الاخ كات سنكمل ما تفضل به الاخ قصي ثم سنعود لما طلبت إن شاء الله

الاخ الفاضل/ زيد علي حفظه الله اداة رائعة ومفيدة جدا جدا جزاك الله خيرا و ===============================================================

السلام عليكم استخدم الكود التالي Sub KH_START() Dim R As Integer, M As Integer, N As Integer Sheets("ناجح").Range("A9:ap1000").ClearContents Sheets("راسب").Range("A9:ap1000").ClearContents M = 9: N = 9 Application.ScreenUpdating = False For R = 1 To 1000 If Cells(R, 43) = "ناجح" Then Range("A" & R).Resize(1, 43).Copy Sheets("ناجح").Range("A" & M).PasteSpecial xlPasteValues Application.CutCopyMode = False M = M + 1 ElseIf Cells(R, 43) = "راسب" Then Range("A" & R).Resize(1, 43).Copy Sheets("راسب").Range("A" & N).PasteSpecial xlPasteValues Application.CutCopyMode = False N = N + 1 End If Next MsgBox ("الحمد لله تـــم ترحيل الناجحين و الراسبين إلى أوراق عمل جديدة ") Application.ScreenUpdating = True End Sub تفضل المرفق 1.rar