ياسر خليل أبو البراء

أخي الكريم أبو وليد السلام عليكم جرب الكود التالي .. يضع السجل (الخلية التي توازي خلية الورقة) في الخلية A1 في الورقة المطابقة لاسم ورقة العمل أرجو أن يكون المطلوب .. Sub Transfer() Dim Cel As Range For Each Cel In Sheets("main").Range("A2:A" & Sheets("main").Cells(Rows.Count, 1).End(xlUp).Row) If Evaluate("=ISREF('" & Cel.Value & "'!A1)") Then Sheets("" & Cel.Value & "").Range("A1") = Cel.Offset(0, 1).Value End If Next Cel End Sub

أخي الحبيب ياسر العربي الحماية في الكود الموجود في الصورة ليست حماية ورقة العمل سواء بكلمة سر أو بدونها إنما هي طريقة للحماية عن طريق وضع كود في حدث تغيير ورقة العمل في نطاق محدد من الخلايا (حماية الخلايا في النطاق من التعديل عليها ..بحيث لو تم التعديل عليها تظهر رسالة تفيد بأن النطاق محمي ويتم التراجع بالكود عن آخر تعديل تم على الخلية) تقبل تحياتي

أخي الحبيب أبو يوسف نظراً لانشغالي فربما يضيع مني فرصة أن أشارك بالموضوع ولكن أضع بين أيديكم موضوع بهذا الخصوص على منتدى إكسيل فور أس http://excelforus.com/vb/showthread.php?t=4575 كما يوجد موضوع في هذا الخصوص في التوقيع الخاص بي تقبلوا تحياتي

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

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

أخي الكريم يرجى في حالة أن النتائج غير متوقعة بالنسبة لك ..يرجى إرفاق شكل النتائج المتوقعة أو وضع المعادلات التي أدت الغرض بالنسبة لك جرب التعديل التالي وإذا لم يؤدي الغرض .. يرجى إرفاق شكل النتائج المتوقعة Sub Ali_C() Dim R As Long For R = 2 To Cells(Rows.Count, 1).End(xlUp).Row If IsDate(Cells(R, 3)) Then If Application.CountIf(Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row), Cells(R, 3)) > 0 Then Cells(Cells(Rows.Count, 5).End(xlUp).Offset(1, 0).Row, 5) = CDate(Cells(R, 3)) End If End If Next R End Sub

تم دمج الموضوعات والشكر موصول لأخي وحبيبي في الله أبا الحسن والحسين على الإفادة بتكرار الموضوعات ونرجو من الأخ السائل عدم تكرار الموضوعات بدون داعي

إذاً ارفق ملف معبر عن الملف الأصلي للإطلاع عليه ومحاولة التعديل وإن كنت أرى أن هذا سيعقد الأمور ..بعض الشيء ولكن دع إخوانك يحاولوا على ملف مرفق لكي تصل إلى حل دقيق وسريع

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

شرين شدت شعر شاهندا شدة شديدة شالت شوية شعر شايب (_شايف شوية شخبطتي)

أخي الكريم أبو احمد إن شاء الله كل شيء بالصبر بيتم بعون الله فقط لو الموضوع شايف إنه هيكون مختلف اطرح موضوع جديد واشرح فيه بالتفصيل المطلوب وإخوانك لن يقصروا معك

شفت شاب شيك شايل شنطه شيك شبه شنطه شارلي شابلن بس خلاص

أخي الغالي الحبيب عبد الباري البنا مشكور على مرورك العطر بالموضوع ..وجزيت خيراً على كلماتك الرقيقة والرائعة تقبل وافر تقديري واحترامي

أخي الكريم أبو فيصل م جرب الملف التالي عله يفي بالغرض Comments In Charts.rar

أخي الكريم ناصر اطرح طلبك في موضوع مستقل مع إرفاق ملف معبر عن الملف الأصلي تقبل تحياتي

أخي الكريم مالك الجن إليك الملف محول بتنسيق 2003 (ولكن لا أدري هل سيعمل معك بكفاءة أم لا على أوفيس 2003 ؟) w-24b54747e0.rar

أخي الكريم المتميز ياسر العربي مشكور على الملف القيم .. والمداعبة اللطيفة بس صاحبك عارف الخدعة دي من زمان .. ومن غير ما أفكر حاولت استخدام مفتاح التاب ..منفعش ..استخدمت الأسهم وخلصت الحكاية بدري بدري وتسلم يا معلم لا حرمنا الله من جديدك أعجبني مراعاة التعامل في الكود ليناسب نظام 64 بت ولم يعجبني أنك أهملت Option Explicit والإعلان عن المتغيرات (يراعى مستقبلاً هذه الأمور التي قد تبدو تافهة) وأفضل أيضاً شرح آليات الملف ..أي الخطوات التي قمت بها ليستفيد الجميع ..كفانا ملفات جاهزة ..نريد ان ننطلق للعالمية يا عربي أقصد بالخطوات ..قم بوضع زر أمر وأعطه اسم برمجي كذا وعنوان كذا ولو غيرت في خاصية محددة تذكرها وهكذا وهكذا .. تقبل وافر تقديري واحترامي

أخي الكريم عمرو هل تم الأمر على خير ..أم أنك تريد الحل بالمعادلات لأنك لم تحدد في طلبك ..؟

أخي الكريم عادل سعد أهلا ومرحباً بك في المنتدى ونورت بين إخوانك يرجى تغيير اسم الظهور للغة العربية قمت بتحميل الملف من أجلك على المنتدى لسهولة تحميله w-24b54747e0.rar

لا داعي لحذف الموضوع فقط أضف مشاركة جديدة تشرح فيها المطلوب بشيء من التفصيل لتجد الاستجابة من إخوانك وإنت مجرب ومفيش حد بيقصر معاك بالتأكيد .. ومتزعلش مني إني بذكرك بالتوجيهات

أخي الحبيب حسام عيسى متميز دائماً بجديدك الممتع جربت الملف وبراء قاعد جمبي ..ووضعت زر أمر التصغير في منتصف الفورم وفضلت أنقر عليه والفورم يصغر وهو يقولي ايه ده يا بابا وكل لما الفورم يصغر يموت على نفسه من الضحك وقالي العب اللعبة دي تاني يا بابا (منك لله يا حوسو ..خليت الولد يفتكر إني بلعب) تقبل تحياتي

أخي الكريم وائل عادةً لا يلتفت إلى الموضوع إذا لم يكن هناك المزيد من التفاصيل ... أنا شخصياً أكره الموضوع التي يلقي صاحبها بالملف المرفق ويخبر أن المطلوب داخل الملف المرفق ...!! لما لا يقوم العضو بشرح المطلوب داخل الموضوع دون أن يضطرني للإطلاع على الملف المرفق !!! لابد للموضوع أن يستوفي الأركان لكي يجد قبول من الآخرين راجع التوجيهات ولا تنزعج من نصحي (فما أردت إلا المصلحة دائماً ... والمصلحة تقتضي منا العمل وفق قواعد وأسس وتوجيهات لنصل إلى مبتغانا في أسرع وقت وبأقل جهد) تقبل تحياتي

أخي الحبيب محمد الريفي بارك الله فيك وجزاك الله كل خير على الموضوع الرائع والمتميز خاصية جميلة يجهلها الكثيرون

أخي الكريم عمرو عبد الحليم يرجى الإطلاع على موضوع التوجيهات في الموضوعات المثبتة في صدر المنتدى .. حيث أن العنوان "السلام عليكم" لا يعد عنوان معبر عن الطلب أو الموضوع كما أنه يرجى دائماً إرفاق الملف المعبر عن الملف الأصلي من بداية الموضوع جرب الكود التالي ..يقوم الكود بنسخ النطاق في العمودين الأول والثاني ويضع القيم في العمود G و H ثم يقوم بفرز أو ترتيب حسب العمود G من الأكبر إلى الأصغر يمكنك التعديل على الكود ليلائم طلبك Sub SortData() Dim LR As Long LR = Range("A" & Rows.Count).End(xlUp).Row Application.ScreenUpdating = False Range("A1:B" & LR).Copy Range("G1") Range("G1:H" & LR).Sort Key1:=Range("G1:G" & LR), Order1:=xlDescending, Header:=xlNo Application.CutCopyMode = False Application.ScreenUpdating = False End Sub تقبل تحياتي Sort Data YasserKhalil.rar

أخي الكريم في عجالة سريعة عشان عندي شغل بالنسبة للطلب الاول هل القيمة صفر المراد البحث عنها في الصف 17 في عمود محدد أم في أي عمود في الصف 17 بالنسبة للطلب الثاني جرب الكود التالي Sub Test() Dim Cel As Range For Each Cel In Sheet2.Range("A1:A" & Sheet1.Cells(Rows.Count, "A").End(xlUp).Row) If Cel.Value = "مصطفى" Then Cel.EntireRow.Delete Next Cel End Sub جرب الكود بهذا الشكل Sub Test() Dim Cel As Range, LastCol As Long, I As Long LastCol = Sheet1.Cells(17, Columns.Count).End(xlToLeft).Column For I = 1 To LastCol If Cells(17, I) = 0 Then Rows(17).Hidden = True: Exit Sub Next I For Each Cel In Sheet2.Range("A1:A" & Sheet1.Cells(Rows.Count, "A").End(xlUp).Row) If Cel.Value = "مصطفى" Then Cel.EntireRow.Delete Next Cel End Sub تقبل تحياتي