رجب جاويش

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

السلام عليكم تفضل أخى ما تريد تم التطبيق على ورقة 2 كلمة المرور 123 منع دخول الصفحة الابرقم سري.rar

السلام عليكم تفضل أخى ما تريد Suppliers Coder - Copy.rar

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

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

أخى الفاضل / صلاح الصغير جزاك الله كل خير ما رأيك مثلا فى الحصول على رقم ناتج عن ضرب اليوم فى رقم معين فمثلا اذا كان التاريخ 4/4/2015 يتم ضرب اليوم وهو 4 فى رقم معين

أخى الفاضل / A.El Sheikh عذرا أخى لم أفهم قصدك فى المرة الأولى فهل تريد ظهور الفورم فى sheet1 ويتم التعديل فيها أيضا ويتم الاستغناء تماما عن sheet4

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

السلام عليكم أخى الفاضل تم تنفيذ ما طلبت مع تعديل بسيط فى الفكرة الأولى وأرجو أن تعجبك جعلت كلمات المرور مرتبطة بأيام الشهر بحيث فى الأيام السبعة الأولى من الشهر تكون كلمة المرور ( الله اكبر ) وفى الأيام السبعة التالية تكون كلمة المرور ( سبحان الله ) وفى الأيام السبعة التالية تكون كلمة المرور ( الحمد لله ) وفى الأيام السبعة الأخيرة تعود كلمة المرور كما كانت وهى ( الله اكبر ) وهكذا فى كل شهر أما غلق محرر الأكواد فيمكنك ذلك عن طريق الدخول الى محرر الأكواد ثم من قائمة Tools تختار VBAProject properties ثم تختار تبويب protection وتضع علامة صح امام الاختيار look project for viewing ثم تضع كلمة المرور فى خانة password وتعيد كتابتها مرة أخرى فى خانة confirm password وفى الملف المرفق كلمة مرور محرر الأكواد 123 كلمة مرور متغيرة كل 7 أيام.rar

السلام عليكم تفضل أخى ما تريد Suppliers Coder - Copy.rar

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

السلام عليكم أخى الفاضل جرب هذا الكود ولكن يجب تعديل تواريخ الأيام فى باقى الصفحات بحيث يكون مثل صفحة 2015 Sub ragab() Dim cl As Range Application.ScreenUpdating = False T = Range("B1").Text On Error Resume Next Set Rng = Sheets(T).Range("C2:ND2") For Each cl In Rng If Range("c2") = cl Then x = cl.Column Range("C3:C35").Copy Sheets(T).Cells(3, x).PasteSpecial xlPasteValues Application.CutCopyMode = False Exit For End If Next Application.ScreenUpdating = True End Sub حيث أن الكود يعمل تمام عند الترحيل الى صفحة 2015 Data.rar

أخى الفاضل وعليكم السلام ورحمة الله وبركاته أحبك الله الذى أحببتنى فيه هذا هو عنوان صفحتى على الفيس للتواصل كما تحب https://www.facebook.com/profile.php?id=100000422685744 وسوف يتم نقل هذا الموضوع للمنتدى الاجتماعى

السلام عليكم ورحمة الله وبركاته سلمت يداك أخى الفاضل / سليم والتحية لأخى وجارى الحبيب / ياسر ولاثراء الموضوع هذا حل عن طريق الكود ويمكن من خلاله ايجاد المكرر فى أى عدد من الصفحات مع مراعاة وضع اسم الصفحة التى يتم فيها تجميع المكرر بدلا من sheet3 فى السطر التالى Set sh = Sheets("sheet3") Sub ragab_Tekrar() Dim sh As Worksheet Set sh = Sheets("sheet3") sh.Range("D4:E10000").ClearContents LR = sh.Cells(Rows.Count, 2).End(xlUp).Row Set Rng = sh.Range("B4:B" & LR) Application.ScreenUpdating = False For i = 1 To Sheets.Count If Sheets(i).Name <> sh.Name Then LR1 = Sheets(i).Cells(Rows.Count, 2).End(xlUp).Row Set Rng1 = Sheets(i).Range("B4:B" & LR) For Each cl In Rng If Application.WorksheetFunction.CountIf(Rng1, cl) >= 1 Then T = sh.Cells(Rows.Count, 4).End(xlUp).Row + 1 sh.Cells(T, 4) = cl sh.Cells(T, 5) = Sheets(i).Name End If Next End If Next Set sh = Nothing Application.ScreenUpdating = True End Sub Book11.rar

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

أخى الفاضل / فارس فؤاد جزاك الله كل خير على مجهودكم الرائع

أخى الفاضل جرب الحل هذه المرة بالأكواد Book3333.rar

أخى الفاضل / الساهر جزاك الله كل خير

تفضل أخى تكون المعادلة كالآتى =LOOKUP(2;1/(($B$4:$B$26=G2)*($E$4:$E$26<>""));$E$4:$E$26) Book2.rar

السلام عليكم تفضل أخى Book1.rar

لقد تشرف الموضوع بمرور الأستاذ الكبير الحسامى نورت بيتك أستاذنا الكبير الحسامى ويا ريت ما تحرمناش من ابداعاتك المتجددة

أخى الفاضل / nessemyousef أخى الحبيب / ياسر خليل تم نقل المشاركة فى موضوع جديد مع خالص تحياتى

أخى الفاضل / ياسر خليل تشرف وتنور بلشاى كلها ونفرشلك الأرض ( 000000 ) ولا خليها ورد وبلاش اللى انت عارفه أخى الفاضل / ابو سليمان شكرا جزيلا أخى الكريم على هذه المشاعر الطيبة ولكن تكرم أنت وأخى الفاضل ياسر على أرض بلشاى أولا وبعدين لينا زيارك عندك ان شاء الله

بعد اذن أخى الحبيب ياسر خليل تفضل أخى جرب الكود التالى Sub ragab() Dim sh As String Application.ScreenUpdating = False On Error Resume Next '====================================================== For ii = 1 To Sheets.Count If Sheets(ii).Name <> "ورقة1" Then Sheets(ii).Range("A2:H1000").ClearContents End If Next '====================================================== For i = 2 To Cells(10000, "H").End(xlUp).Row sh = Cells(i, "H").Value T = Sheets(sh).Cells(10000, 2).End(xlUp).Row + 1 Range(Cells(i, "B"), Cells(i, "H")).Copy Sheets(sh).Range("B" & T).PasteSpecial xlPasteValues Sheets(sh).Range("A" & T) = T - 1 Application.CutCopyMode = False Next i '====================================================== Application.ScreenUpdating = True MsgBox "تم الترحيل بنجاح" End Sub malade.rar

أختى الفاضلة فى الكود التالى Private Sub CommandButton1_Click() If TextBox1.Value = "" And TextBox2.Value = "" Then Application.ScreenUpdating = False Unload Me main_screen.Show Exit Sub End If TextBox1.Value = "" TextBox2.Value = "" TextBox1.SetFocus End Sub يتم تغيير السطر If TextBox1.Value = "" And TextBox2.Value = "" Then بالسطر التالى If TextBox1.Value = Sheet1.Range("E5").Text And TextBox2.Value = Sheet1.Range("E6").Text Then علما بأن اسم المستخدم هو ragab وكلمة المرور هى 123 وهذه البيانات يمكنك تغيرها من صفحة واجهة الدخول ويمكنك التجربة من الملف المرفق واجهه كنترول للاستاذ الحسامي.rar