رجب جاويش

أخى / عبد الرحمن جزاك الله كل خير

أستاذى الفاضل / محمد يوسف فكرة جميلة بارك الله فيك وجزاك الله كل خير

أختى الفاضلة / سما محمد جزاك الله كل خير على هذه الكلمات الطيبة

أخى الفاضل / عادل ابو زيد جزاك الله كل خير على هذا الدعاء الطيب وجعل الله لك بمثله أضعافا كثيرة

أخى الحبيب / جمال عبد السميع ابداع لا ينتهى جزاك الله كل خير

أخى الحبيب / حمادة عمر بارك الله فيك وبارك الله لك فى الأمورة سما

أستاذى الحبيب / عبد الله باقشير سلمت يداك وحفظك الله لنا مبدعا

أخى / عبد الرحمن تفضل ما تريد الفرز التلقائي في ورقة محمية.rar

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

استادي الحبيب // عبد الله باقشير جزاك الله خيرا على هدا الحل الرائع

أخى الحبيب / أبو حنين جزاك الله كل خير على استجابتك السريعة للمساعدة جعله الله فى ميزان حسناتك وجزاك الله كل خير

أخى الفاضل أولا : لك منى دعوة طيبة بتغيير اسم الظهور الى اللغة العربية حتى يسهل التواصل بيننا ( طبقا لسياسة المنتدى ) ثانيا: يرجى اختيار عنوان مناسب للموضوع يدل على محتوى الطلب ثالثا : تم تغيير العنوان ولكن فضلا الاهتمام بهذه النقطة فى المرات القادمة

أخى ممكن حماية الصفحة بكلمة مرور

تفضل أخى Sub PDF_SAVE() Dim PDF_Name As String On Error Resume Next F_path = ThisWorkbook.Path F_Name = Range("J4").Value PDF_Name = F_path & "\" & F_Name & ".pdf" If Not Dir(PDF_Name, vbDirectory) <> vbNullString Then ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ PDF_Name, Quality:=xlQualityStandard, _ IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True Else MsgBox "هذا الملف موجود مسبقا" End If End Sub حفظ ملف بامتداد PDF.rar

شكرا جزيلا أخى الحبيب / محمد أبو البراء وجزاك الله كل خير

أستاذى الفاضل / محمد يوسف جزاك الله كل خير

أخى الحبيب / محمد أبو البراء أحسنت وأبدعت

أستاذى الفاضل / محمد يوسف جزاك الله كل خير

بعد اذن أستاذى الحبيب أختى الفاضلة / سما محمد يكون التعديل فى الكود كالآتى Private Sub CommandButton1_Click() Dim Cntl As Control Dim Txt As String For Each Cntl In Me.Controls If TypeOf Cntl Is MSForms.CheckBox Then If Cntl.Value = True Then Txt = Txt & IIf(Len(Txt), " - ", "") & Cntl.Caption End If End If Next Range("B2").Value = Txt End Sub وبالنسبة للفورم يتم ازالة الـ FRAME1 التشيك بوكس.rar

أخى الفاضل الأستاذ / محمد يوسف هل تقصد هكذا Sub ragab() Set Rng = Sheets("ورقة2").Range("C2:C353") Application.ScreenUpdating = False [D2:E1000].ClearContents For Each cl In Rng If cl.Row Mod 2 = 1 Then LR1 = Cells(Rows.Count, "D").End(xlUp).Row + 1 Cells(LR1, "D") = cl Else LR2 = Cells(Rows.Count, "E").End(xlUp).Row + 1 Cells(LR2, "E") = cl End If Next Application.ScreenUpdating = True End Sub الخلايا.rar

أخى الحبيب / محمد أبو البراء تسلم ايديك وجزاك الله كل خير

أخى الحبيب / الشهابى تسلم ايديك وجزاك الله كل خير

أخى الفاضل / شرقاوى يمكنك ذلك من عمل حماية للصفحة بعد تحديد الخلايا المحتوية على المعادلات وتنشيط الاختيارين Locked و Hidden من تنسيق الخلايا الربط بين البيانات.rar

أخى الحبيب / محمد أبو البراء تسلم ايديك ولاثراء الموضوع هذا حل آخر بالكود Sub ragab() Set Rng = Sheets("ورقة2").Range("C2:C353") Application.ScreenUpdating = False [D2:E1000].ClearContents For Each cl In Rng If cl Mod 2 = 1 Then LR1 = Cells(Rows.Count, "D").End(xlUp).Row + 1 Cells(LR1, "D") = cl Else LR2 = Cells(Rows.Count, "E").End(xlUp).Row + 1 Cells(LR2, "E") = cl End If Next Application.ScreenUpdating = True End Sub الخلايا.rar

أخى الفاضل / عبد الرحمن جرب المرفق الفرز التلقائي في ورقة محمية.rar