۩◊۩ أبو حنين ۩◊۩

السلام عليكم الاخوة الكرام هل من حل لعدم تكرار الترحيل عند تنفيذ الكود يتم كتابة تم الترحيل امام الخلايا التى تم ترحيلها فى العمود H وذلك يكون شرط لعدم الترحيل .... اى عند وجود كلمه تم الترحيل فى العمود H مستحقات العاملين والاستعاضة.rar

السلام عليكم الاخ الكريم طارق .. جزاك الله كل الخير وارجو ان تشرح لنا المعادله جزاك الله كل الخير

للرفع

الحمد لله تم بحمد الله عمل الكود وذلك بتتبع اعمال الاخ الكبير بن علية حاجى والاخ الكريم ياسر ابو البراء ولهم كل الشكر والتقدير فيما يفمو به من شرح وافى لما يقدمونه من اعمال جزاكهم الله كل الخير الكود لمن اراد الاستفاده Sub printing() Application.ScreenUpdating = False On Error Resume Next sama = MsgBox("سيتم طباعة جميع الشيتات بالشرط... هل أنت متأكد من إجراء هذه العملية ؟", vbYesNo, "الشئون الادارية .. حقول طارق @ طباعة جميع الشيتات@") If sama = vbYes Then For Each Sh In Worksheets If Sh.[A1] = "print" Then Sh.PrintOut Copies:=1 Next Else MsgBox " !! لم تتم الطباعة " End If Application.ScreenUpdating = True Sheets("1").Select End Sub

كود طباعه بشرط الساده الكرام كل عام وتنتم بكل خير ارجو المساعده فى عمل كود طباعه بشرط اذا كان محتوى الخليه A3 الموجوده فى الشيت الذى اسمه 1 Medi. Kha او Medi. Epe يتم طباعه شيت 1 وشيت DATA اذا كان محتوى الخليه A3 الموجوده فى الشيت الذى اسمه 1 Sub يتم طباعة شيت 1 وشيت DATA و شيت check جزاكم الله كل الخير

للرفع للرفع للرفع

للرفع

السلام عليكم الاخوة الكرام كل عام وانتم بكل خير ارجو المساعدده فى اضافه على كود اولا الكود للاخ الكريم ياسر خليل ... اكرمة الله بكل الخير المطلوب اضافة الغرض منها عدم تكرار الترحيل للبيانات المرحله اذا تم اضغط على رز الترحيل اكثر من مرة Sub Transfer1() Application.ScreenUpdating = False On Error Resume Next Dim Cell As Range, T As String, LR As Long, LRT As Long Dim WS As Worksheet, Answer As Long Set WS = Sheets("1") LR = WS.Cells(35, 3).End(xlUp).Row T = WS.Range("A3").Value Application.ScreenUpdating = False WS.Unprotect "2191612" If Not IsEmpty(WS.Range("c6")) Then With Sheets(T) .Unprotect "2191612" LRT = .Cells(Rows.Count, 3).End(xlUp).Row + 1 WS.Range("B6:G" & LR).Copy .Cells(LRT, 2).PasteSpecial xlPasteValues .Protect "2191612" End With Answer = MsgBox("تم ترحل البيانات .....هل تريد أن مسح البيانات المرحلة؟", vbYesNo + vbQuestion) If Answer = vbYes Then Sheets("1").Activate Sheets("1").Range("A3,C6:C35,F6:G35").Select Selection.ClearContents Else MsgBox "!! لم يتم الحذف" End If Sheets("1").Select ActiveWindow.SmallScroll Down:=-12 Range("A3,C6").Select Else MsgBox "الخلية المحددة فارغة لذا لن يتم تنفيذ الكود": Exit Sub End If WS.Protect "2191612" Application.CutCopyMode = False Application.ScreenUpdating = True End Sub

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

السلام عليكم اخى الحبيب ياسر ارجو تقديم شرح وافى للمعادله الخاصة بالقائمة المنسدلة لانى اريد التعديل عليها ... اريد ان تستقى من العمود AA وما دلالة الارقام الملونة بالون الاحمر وجزاك الله كل الخير =INDIRECT("'"&$A$1&"'!"&ADDRESS(1;1)&":"&ADDRESS(2;1))

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

السلام عليكم جزاك الله كل الخير اخى ياسر .. هذا هو المطلوب اسباته وجزاك الله كل الخير اخى سليم ... يسعدنى مرورك والمشاركة المفيده

السلام عليكم الاخوة الكرام اريد عمل قائمة منسدلة فى شيت 1 من F1 الى F25 بدلالة اسم الشيت اى عند اختيار اسم شيت محدد فى الخليه A1 وليكن شيت 2 تظهر قائمة منسدلة معينةمصدرها A1 و A2 فى شيت 2 وعند اختيار اسم شيت محدد فى الخليه A1 وليكن شيت 3 تظهر قائمة منسدلة معينةمصدرها A1 و A2 فى شيت 3 و عند اختيار اسم شيت محدد فى الخليه A1 وليكن شيت 4 تظهر قائمة منسدلة معينةمصدرها A1 و A2 فى شيت 4 قائمة منسدله بدلابه اسم الشيت.rar

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

السلام عليكم اخى محمد المقصود بالرجوع الى الجدول الاصلى هو عند عدم كتابه اى شئ فى الخليه d3 وعند تنفيز الكود يظهر جميع الجدول ويكفينى تقديم يدالمساعده بشكرا وليس بتطفل اخى الحبيب فى حفظ الله

السلام عليكم اخى الحبيب ياسر اصبحت وامسيت بكل الخير واسال الله ان يجعل ما امضيت من وقت فى ميزان حسناتك اخى الحبيب كيف الحال اذا كانت المطلوب البحث عن حالة العامل بغض النظر حاضر ام غائب اى الرقم بين التاريخين اى سواء كان حاضر ام غائب اخيرا كيف الرجوع الى كامل الجدول والمقصود به عند عدم كتابه اى رقم فى الخليه D3 واستخدام الكود يظهر كل الجدول بجمبع بياناته هل يمكن تحقيق الامر جزاك الله كل الخير

السلام عليكم الاخوة الكرام كل عام وانتم بالف خير هل يمكن عمل تصفيه على اساس رقم العامل الذى يوضع فى الخليهD3 ومصدر رقم العامل العمود C وخلال الفترة من ..D1.. الى فترة ....D2.... مع العلم ان مصدر التاريخ هو عمود واحد فقط وهو العمود E بلاضافة الى Description اى كونه حاضر ام غائب من خلال الخليه G1 والتى مصدرها العمود F تصفية.rar

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

اخى ياسر بعد ان تم اضافة النقطة كما بينت ...منعت ظهور الرساله الا ان الترحيل لا يتم مرفق الملف Book7.rar

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

السلام عليكم لقد قام الاخ الكريم والمعلم الكبير ياسر خليل بعمل كود ترحيل ... يتم الترحيل على اساس اسم الشيت والذى مصدره الخليه A3 ولقد قمت بحمايه الشيتات التى يتم الترحيل اليها بكلمه سر 2191612 وعند تنفيذ الكود ...... لا يتم الترحيل اذا ما كانت الشييتات محمية ولقد حاولت .... الا ان المحاولات بائت بالفشل .... واظن لان كلمه ActiveSheet.Unprotec يقد بها الشيت الذى اقف فيه ويتم تنفيذ الكود منه المراد فك حمايه الشيتات التى يتم الترحيل اليها ()Sub Transfer1 Application.ScreenUpdating = False On Error Resume Next "ActiveSheet.Unprotect "2191612 Dim Cell As Range, T As String, LR As Long, LRT As Long Dim WS As Worksheet, Answer As Long Set WS = Sheets("1") LR = WS.Cells(35, 3).End(xlUp).Row T = WS.Range("A3").Value Application.ScreenUpdating = False If Not IsEmpty(WS.Range("c6")) Then Range("B6:G" & LR).Copy With Sheets(T) LRT = .Cells(Rows.Count, 3).End(xlUp).Row + 1 .Cells(LRT, 2).PasteSpecial xlPasteValues End With Answer = MsgBox("تم ترحل البيانات .....هل تريد أن مسح البيانات المرحلة؟", vbYesNo + vbQuestion) If Answer = vbYes Then Sheets("1").Activate Sheets("1").Range("A3,C6:C35,F6:G35").Select Selection.ClearContents Else MsgBox "!! لم يتم الحذف" End If Sheets("1").Select ActiveWindow.SmallScroll Down:=-12 Range("A3,C6").Select Else MsgBox "الخلية المحددة فارغة لذا لن يتم تنفيذ الكود": Exit Sub End If Application.CutCopyMode = False Application.ScreenUpdating = True "ActiveSheet.Protect "2191612 End Sub

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

اخى ياسر واضح انى اثقلت جدا عليك اريد اذا اردت تنفيذ الكود وانا فى شيت Medi. Kha استطيع ذلك واذا كنت فى شيت Medi. Eps واردت تنفيذ الكود استطيع ذلك لان الكود واقف تنفيذ على شيت Medi. Kha ("Set WS = Sheets("Medi. Kha اخى ياسر خلية D3 في كل ورقة منفصلة عن الأخرى اى الخليه D3 فى شيت Medi. Kha تخص ذلك الشيت فقط و الخليه D3 فى شيت Medi. Eps تخص ذلك الشيت فقط لقد كررت الكود بما يتناسب وشيت Medi. Eps ده حل مؤقت حتى تدلنى على الصح Sub FilterData1() Dim WS As Worksheet Dim myCrit Set WS = Sheets("Medi. Epe") myCrit = Range("D3") With WS .AutoFilterMode = False .Range("A4:G4").AutoFilter Field:=3, Criteria1:="" & myCrit End With End Sub

السلام عليكم اخى الكريم ياسر اعلم انى اثقلت عليك من كثره المطلوب وعدم توصيل المطلوب بصوره صحيحه جزاك الله خير على صبرك معى اخى الحبيب ياسر اريد ان يتم تنفيز الكود على شيت Medi. Kha وكذلك شيت Medi. Eps ويكون العمل على نفس الخليه D3 لقد قمت بالتغير الذى ذكرته والكود يعمل بصوره ممتازه ويبقى جعل الكود يعمل على شيت Medi. Kha وكذلك شيت Medi. Eps Book6.rar

السلام عليكم اخى الكريم ياسر الكود يعمل على عكس المطلوب عند كتابه الرقم وتنفيذ الكود .... تظهر بيانات جمبع الارقام الا بيانات هذتا الرقم ولاحظت ان الكود به ( Set WS = Sheets("Medi. Kha") ) واريد ان يعمل ايضا على شيت ( Medi. Eps ) تقبل منى كل التقدير والاحترام