حسين مامون

السلام عليكم سبب مشكلتك اظن هذا الكود فعندما تنتقل الى شيت "ملاك" ينشط الكود ويلغي عملية اللصق Private Sub Worksheet_Activate() ScreenOn End Sub Sub ScreenOn() Application.Calculation = xlAutomatic Application.EnableEvents = True Application.ScreenUpdating = True End Sub

السلام عليكم بعد اذن الاستاذ جرب تغيير بسيط في الكود اضف "Value" الى textbox1 و textbox2 .Range("A" & lastRow).Value = TextBox1.Value .Range("B" & lastRow).Value = TextBox2.Value مثال.xlsm

نسال الله لها الرحمة والمغفرة والفردوس الاعلى من الجنة و لا حول و لا قوة الا بالله انا لله وانا اليه راجعون

وعليكم السلام بعد اذن الاستاد سليم ربما تقصد هذا Sub test() ActiveCell.Offset(, 1).Select End Sub

الحمد لله ان تم الامر

تفضلي 99999999999999999999999999999999999.xlsm وهذا من 5 الى 2 99999999999999999999999999999999999.xlsm

حاولي رفع نمودج لما تريدين ضعي رق 5 ونتيجته و رقم 4 ونتيجته و 3 ونتيجته

جرب المرفق 99999999999999999999999999999999999.xlsm

اخي الكريم لديك امتداد الملفات المخزنة في المجلد هو :xlsm وفي الكود xlsx اخل الى الكود وحول الامتداد من File = Dir(Path & "*.xlsx*") الى File = Dir(Path & "*.xlsm*") وسيعمل بحول الله وقوته

اخي الكريم جزاك الله خيرا لازم ترفع نمودج لملف العمل تحياتي

بعد اذن الاستاذ عبدالفتاح في بي اكسيل واثراء للموضوع جرب هذه الطريقة اليك هذا الماكرو Sub pastespcolwid() ' Keyboard Shortcut: Ctrl+q ActiveCell.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False ActiveSheet.Paste End Sub ضعه في مديول ثم اهب الى Macro ثم Options ثم ادخل حرف Q لاختصار الماكرو انظر الصورة الماكرو ينفذ عملية اللصق عن طريق لوحة المفاتيح والطريقة هي : حدد النطاق الذي تريد ثم نسخ ثم اذهب الى مكان اللصق ثم على لوحة المفاتيح اضغط زر CTRL+Q وهذا المرفق Book1.xlsm

عمل رائع استاذ وجيه شرف الدين جزاك الله خيرا وتقبل منك

الف الف مبروك للاستادين عبد الفتاح و الرائد رمضان كريم

حدد الليستبوكس واذهب الى انظر الصورة

اتمنى ان يكون ما تريد في هذا العمل stok.xlsm

بعد اذن استادي ابراهيم الحداد هذا المرفق Private Sub Workbook_SheetActivate(ByVal Sh As Object) Dim i i = 1 For Each Sh In Sheets 'يمكنك تغيير اسماء الشيتات التي لا تريد ترقيمها If Sh.Name <> "Sheet1" And Sh.Name <> "Sheet2" And Sh.Name <> "Sheet3" And Sh.Name <> "Sheet4" Then Sh.Range("A1").Value = i i = i + 1 End If Next End Sub test.xlsm

اخي الكريم كان عليك تحديد نقطة واحدة مثلا طلب ادخال بيانات جديدة وشرح المطلوب جيدا مع ادخال بعض البيانات في الداتا بيس كنمودج ويكفي صفين اعادة تصميم الصفحة المصدرة للبيانات ( عدد عناوين الجدول في الداتا اكبر من عدد عناوين الجدول في main) حاول ايصال ما تريد بطريقة جيدة وخطوة خطوة . وانشاء الله تجد مساعدة من الاساتذة تحياتي

جزاك الله خيرا استاذ مجدي

انظ الصورة ادا كان البارتشن :C كما في الصورة فيمكن ان يعمل المشكلةدي حدثت معي ذات مرة وقمت بنقل بعض محتويات من :C الى:D وفتح البرنامج عادي

بعد اذن استاذنا وجيه شرف الدين واثراء للموضوع اليك المرفق ولكن بكود VBA ادخل قيمة البحث في الخلية b1 test.xlsm

حاولت تحميل ملفك ولك لا يفتح معي اعد تحميل الملف ولكن بدون كلمة سر مع شرح واضح لما تريد

جرب المرفق ملاحظة: يجب ان يكون التاريخ في الصفحات من الاصغر الى الاكبر وكذلك يجب ان يكون تنسيق التاريخ هكذا مثلا 02/03/2020 تجميعه.xlsm

في اي عمود صفحة data تبحث بتاريخ اليوم وفي اي عمود صفحة data تبحت بين تاريخين departure وفي اي عمود صفحة data تبحت بين تاريخين Reservation

استاد سليم انت معلم ربنا يحفظك ويزيدك من فضله

بعد ادن الاستاد ونحن جالسين الايام دي فلا مانع في محاولة انظر المرفق كشف الحضور.xlsm