عبدالله المجرب

من الافضل توضيح المطلوب دفعة واحدة لتوفير الوقت بارك الله فيك اخي ابو حنين

السلام عليكم العنوان كما هو وساقوم بتغييره بعد اذن الاخوة الكرام ولكن للاسف الاخ الفاضل لم يلتزم هنا بالقواعد http://www.officena.net/ib/index.php?showtopic=41724

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

السلام عليكم اليك المرفق وبه الحل في الخلية A1 يتم وضع الصف التالي للترحيل فيرجى عدم التغيير فيها واذا اردت مسح البيانات والبدء من جديد ضع فيها الرقم 5 Copy of PAY HOTEL-1.rar

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

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

ان شاء الله الامر ممكن ضع مرفق للعمل عليه

السلام عليكم هذا التعديل Sub دور_ثاني() Test_1 = "دور ثان" Test_2 = "لها ور ثانٍ فى" HidMyRow Test_1, Test_2 End Sub Sub الناجحين() Test_1 = "ناجح" Test_2 = "نـاجـــــــحة" HidMyRow Test_1, Test_2 End Sub Sub الغايبين() Test_1 = "غائب" Test_2 = "نـاجـــــــحة" HidMyRow Test_1, Test_2 End Sub Sub HidMyRow(Test_1, Test_2) MyCol = 28 MyCol2 = 10 Application.ScreenUpdating = False Rows.Hidden = False Serial = 0 For MyRow = 10 To 34 ChkMy = Cells(MyRow, MyCol) ChkMyNum = Cells(MyRow, MyCol2) If ChkMy <> Test_1 And ChkMy <> Test_2 Or ChkMyNum = "" Then Rows(MyRow).Hidden = True Else Serial = Serial + 1 Cells(MyRow, 3) = Serial End If Next Application.ScreenUpdating = True End Sub Sub ShowAll() Application.ScreenUpdating = False Rows.Hidden = False Range("B6:B7").ClearContents MyCol2 = 4 For MyRow = 10 To 34 ChkMyNum = Cells(MyRow, MyCol2) If ChkMyNum <> "" Then Cells(MyRow, 3) = MyRow - 5 End If Next Application.ScreenUpdating = True End Sub

فقط في هذا التاريخ ام ابتداء من هذا التاريخ

ادرجها كصورة

السلام عليكم الحمدلله اعتقد ان المحاولة نجحت اليك الحل مضاف اليه زر التعديل من عبد الله الى ابو شرف (1).rar

اليك هذا الموضوع به ما تطلب http://www.officena.net/ib/index.php?showtopic=34859&hl=&fromsearch=1

اخي احمد لا داعي للرفع فالموضوع مثبت (سيحتاج الموضوع الى تنقيح) بالفعل ما افاد به الاستاذ ابو ادم عمل مجدي واكثر نفعاً من رايي

اخي بصراحة نحن بحاجة الى توضيح اكثر في المطلوب (في ملفك)

أحسنت اخي ابو حنين

اخي هاني بصراحة المطلوب غير مفهوم

اخي ابو شرف يوسفني ان اقول ان انتظارك قد يطول فمحاولاتي بات بالفشل الله المستعان ويسهل طريقة لدمج التعديل مع الفورم

السلام عليكم جرب هذا الكود Sub Abu_Ahmed() Dim cl As Range For Each cl In Sheets("Sheet1").AutoFilter.Range If Not cl.HasFormula = True Then cl = "" Next End Sub

تم التنبيه بسبب مخالفة القواعد

السلام عليكم اولا ً : نرجو لالتزام بقواعد المشاركة (ثاني تنبيه) وعدم تكرار المواضيع ثانياً لا توجد فورم في الملف

اخي ارفق مثال لمشكلتك للعمل المباشر عليه

اليك المرفق بعد التعديل Book100.rar

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

السلام عليكم بعد اذن البشمهندس طارق ضع هذا الكود في حدث ورقة العمل وبعد الادخال تحرك بالاسهم Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, [A4:A53]) Is Nothing Then Target.Offset(0, 3).Select End If If Not Intersect(Target, [D4:D53]) Is Nothing Then Target.Offset(1, -3).Select End If End Sub

اذا كان هذا طلبك فيجب ان يكون التعديل خيار ضمن فورم الترحيل والاستدعاء