الحسامي

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

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

السلام عليكم احبائي ايه يا عم ياسر العزومة لناس وناس بس على العموم ملحوقة ----------------- وبعد اذن اخي رجب هنا كود اخر لاثراء الموضوع Dim SH As Worksheet Dim rng As Range, cell As Range Set rng = Range([E2], Cells([E10000].End(xlUp).Row, "E")) For Each cell In rng Set SH = Sheets(3) If cell.Value > 19 Then Set SH = Sheets(2) LR = SH.[B10000].End(xlUp).Row + 1 SH.Cells(LR, "B").Resize(1, 7).Value = cell.Offset(0, -3).Resize(1, 7).Value Next cell Range("B2:H" & [B10000].End(xlUp).Row).ClearContents

والله مجهود خرافي وافكار جميله ويدل على المستوى العالي الذي تتمتع به بارك الله فيك

لا اصدق ما اراه هل هناك ما زال يستخدم نسخة 2003 النسخة الامثل للاستخدام 2010 بالرغم من الاضافات الخيالية لنسخة 2013 ومع بعض الوقت ووضوح الصورة بالشكل الكامل ستصبح نسخة 2013 النسخة الخرافية لتطبيقات الاكسل نصيحة للذين يستخدمون 2003 ستندمون على الايام التي لم تستخدموا النسخ اللاحقة سواء 2007 او 2010

السلام عليكم اخي الكريم قد لا اكون قد فهمت الموضوع بصورة كاملة لكن هنا محاولة قد تفيدك جدول الصف الاول.rar

ما شاء الله عليك اخي جمال ------------- اخي منير استخدم في الكود ActiveCell وليس Target If ActiveCell.HasFormula = True Then ActiveCell.Offset(0, 1).Select

المنتدى منور بك اخي خبور لا حرمنا الله من علمك وخلق الطيب وما منعا الا هموم الحياة واشغالها بارك الله فيك وفي احبائك

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

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

السلام عليكم مبدع اخي عبدالله كعادتك ومن بعد اذنك هنا محاولة اخرى Sub Macro1() Application.ScreenUpdating = False Dim Cont As Integer, rng As Range, R As Integer On Error Resume Next Cont = Application.InputBox("أدخل عدد الصفوف", , 2, , , , , 1) If Cont = 0 Then Exit Sub Set rng = Range([A7], [A65536].End(xlUp)) R = rng.Rows.Count rng(1, 1).EntireColumn.Insert Set rng = rng.Offset(0, -1) rng(1, 1).Value = 1 rng(1, 1).AutoFill Destination:=rng, Type:=xlFillSeries rng.Copy rng.Offset(R, 0).Resize(R * Cont, 1) rng.Resize(R * (Cont + 1), 256).Sort Key1:=rng(1, 1), Order1:=xlAscending, Header:=xlNo rng.EntireColumn.Delete End Sub

السلام عليكم هنا محاولة قد تفيدك تواريخ.rar

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

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

السلام عليكم عذرا على التاخير اخي سعيد هنا تعديل قد يكون المطلوب حسب وصول الصورة لي وغير ذلك اعلمني اخي الحبي ابو نصار شاكرا لك لمرورك الطيب وكلامك الاطيب وبالتوفيق حساب قيمة خلال مدتان مختلفتان - عماد الحسامى - سعيد بيرم3.rar