نجوم المشاركات

استعمل هذا الكود Sub MyNmbr() Dim x As Integer, i As Integer x = 1 For i = 2 To Range("a1").Value * 3 Step 3 Cells(i, 3) = x x = x + 1 Next End Sub

ربما كان هذا المطلوب test2 salim.rar

ما شاء الله تبارك الله كفيتم ووفيتم كتب الله لكم الأجر وغفر لكم الذنب وأعانكم لكل خير عظيم الشكر وجزيل الامتنان لكم ..

السلام عليكم ورحمة الله وبركاته اكتب هذه المعادلة فى الخلية H3 =IF(OR($D3:$G3="ح");"ح";IF(OR($D3:$G3="غ");"غ";SUM($D3:$G3))) ثم اضغط على CRTL + ALT + SHIFT ثم اسحب نزولا

أخي الكريم سيد يرجى وضع عناوين مناسبة ومعبرة عن الطلب ..بارك الله فيك قم بالتالي : انسخ الكود لموديول جديد والصقه في الموديول .. في ورقة العمل المسماة "قوائم" وفي الخلية D1 ضع الصف المطلوب جلب القوائم له وليكن الرقم 1 للصف الأول في نفس ورقة العمل وفي الخلية المجاورة في الخلية E1 ضع الفصل المطلوب جلب القوائم له وليكن 1 أيضاً أي 1 / 1 ... ثم ارسم زر أمر واعمل كليك يمين عليه ثم Assign Macro واختر اسم الماكرو Test ليكون مرتبط بالتنفيذ .. انقر على زر الأمر لتنفيذ الكود ..وياريت تراجع النتائج بشكل جيد الكود من هنا تقبل تحياتي

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

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

شوف الرابط التالي لتعرف كيفية التحميل .. من هنا

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

يمكنك تجربة هذ الملف المصنف salim.rar

السلام عليكم اعتذر على التقصير فى المتابعة على ارض الواقع للجميع ، و نظرا لعدم توجدي بشكل تفصيلي فى كافة الاقسام ، فالترقيات تتم بناء على ترشيحات من الاخوة القائمين على الافسام المختلفة و المراقبين ، و تناقش فى قسم فريق الموقع قبل التنفيذ ، و هذا يحدث الان ، و سيتم التواصل مع من سيتم ترشيحهم من الاخوة خلال ايام. الانضمام الي فريق الموقع هو تطوع و مشاركة فى جهد اداري اضافي ، و عن نفسي اعبره تطوع اضافي بشكل اكبر من كونه ترقية، حيث ان بقاء صلاحيات المشرف مرهون برغبته فى الاستمرار فى المشاركة فى الجهد الاداري. و فى الحقيقة حين لا يتمكن المشرف من القيام به يتم نقله من مجموعة المشرفين الي مجموعة اخرى تضم فريق الموقع السابق جتى لا تتواجد صلاحيات ادارية مع عدد كبير فى نفس التوقيت مما قد يحدث نوع من التضارب فى تثبيت المواضيع و خلافه. و قد حدث اكثر من مرة ان ترك احد الاخوة الاشراف ثم عاد للمشاركة به حين سمحت ظروفه و ذلك بحسب الية الترقيات المتفق عليها و المثبتة فى القسم المفتوح. العناوين الغير واضحة هي مسؤولية مشتركة، فالحالة المثالية يندر حدوثها و هي ان يقرأ العضو الجديد القواعد جيدا قبل المشاركة. و طبعا هذا نادرا ما يحدث و عليه فيتم التنبيه من المشرف مرة او اثنان مع التعديل، فليس من المفترض ان يستمر عضو نفس الخطأ عدة مرات بعد تنبيهه و تعديل العنوان ، و فى بعض الاقسام الاخرى يتم اغلاق الموضوع مع كتابة السبب اذا تكرر نفس الخطأ. أخي ابو تامر ، أرحب بعودتك للمشاركة ، و اذا تُفضل ضم الحساب القديم للحساب الحالي ، ارجو اخباري. (هل رقم الهاتف القديم مازال كما هو ؟) و اذا غيرت رأيك مستقبلا فى أي وقت بخصوص الاشراف و رغبت فى المساهمة مرة أخرى فارجو اخباري.

لتفعيل النسخ الإحتياطي التلقائي ، قم بما يلي: أولاً : إعدادت إختيار قواعد البيانات لعمل النسخ الإحتياطى التلقائي لها 1) انقر على الزر "إعداد النسخ الإحتياطي التقائي". أدخل المسار الكامل لقواعد البيانات التي ترغب في النسخ الاحتياطي لها.بإستخدام الزر "استعراض لإختيار قواعد البيانات" 2)انقر على الزر "إضافة قاعدة بيانات إلي القائمة" لإضافة قاعدة بيانات جديدة. 3) انقر مرتين على أي قاعدة بيانات في القائمة للتعديل أو الحذف. ــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــ ثانياً : إعدادات مسار تخزين النسخ الإحتياطى التلقائي حدد المسار الكامل الذي تريد حفظ قواعد بيانات النسخ الاحتياطي.فيه عن طريق النقر على الزر "تحديد مسار التخزين" وهذا المسار يجب بالفعل أن يكون موجوداً أو سوف يتم إحباط العملية. ــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــ ثالثاً : إعدادات وقت النسخ الإحتياطي التلقائي تحديد وقت بدء النسخ الإحتياطي التلقائي هام جداً جداً جداً أدخل الوقت بهذا التنسيق (HH:MM:SS AM / PM) شرح التسيق HH الساعة MM الدقيقة SS الثانية AM / PM أو ص / م وهذا يشير لتحديد الساعة صباحا او مساءً ويظهر هذا التنسيق فقط عندما تكون إعدادت نظام التشغيل تم تحديد الوقت فيه على نظام 12 ساعة مثال عندما نريد نسخ تلقائى فى تمام الساعة الواحدة ظهراً تكون بهذا الشكل (01:00:00 م ) وفي حالة ضبط إعدادت الوقت فى نظام التشغيل 24 ساعة يكون التسيق (HH:MM:SS) مثال عندما نريد نسخ تلقائى فى تمام الساعة الواحدة ظهراً تكون بهذا الشكل (13:00:00) ــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــ ملاحظـــــة هامــــــــة ـــــــــــــــــــــــــــــــــــ لكى يتم عمل النسخ التلقائي لقواعد البيانات بشكل تلقائي طبقاً للإعدادت المسبقة 1- يجب فتح النموذج المسئول عن النسخ الإحتياطي التلقائي من خلال النقر على الزر "بدء النسخ الاحتياطي التلقائي" وإلا لن يتم النسخ الاحتياطى تلقائيا فى الوقت المحدد طبقاً للإعدادت المحددة 2- فى حالة إستخدام شاشة التوقف أو شاشة حماية إذا كنت ترغب فى الحصول على السرية والحماية للجهاز الخاص بك فى غيابك لن يؤثر ذلك على النسخ التلقائي ☺ ملاحظة هامة جدا جدا جدا يتم تحديد قاعدة بيانات أو أكثر لعمل نسخ احتياطى لها وضغط واصلاح مرة واحدة فقط من الاعدادت يتم تحديد المسار المراد حفظ النسخ الاحتياطى مرة واحدة فقط وقمت بعمل طريقة تجعل البرنامج يقوم كل يوم بعمل مجلد باسم وتاريخ اليوم دون اى تدخل من المستخدم فقط غير فتح النموذج "frmTimer" مشكلة لو تم وضع باسورد لحماية قاعدة البيانات المراد عمل نسخ احتياطى لها عند فتحها فلن يكتمل النسخ التلقائى الالى بسبب كلمة السر هذه ولن يتم عمل اى نسخ احتياطى لباقى قواعد البيانات الاخرى للامانة العلمية : هذا البرنامج حصلت عليه من احد المنتديات الاجنبية ولكن قمت بتعديلات كثيرة جدا للوصول الى هذه النتيجة المثمرة ان شاء الله واضعها بين أيديكم حتى تعم الفائدة AutoBackup.rar

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

سلام عليكم عود على بدء بشرى للمبتدئين في أكسيس سنبدأ إن شاء الله سلسلة شروح جديدة نركز فيها على الأساسيات فى أكسيس و موضوعات مهمة للمبتدئين و ربما للمتوسطين و أرجو من الله أن تنتفعوا بها أبدأ اليوم بما يسمى حقول البحث فى أكسيس و مكانها الصحيح فى البرنامج وفقكم الله https://m.youtube.com/watch?v=Zl7jU0Q195o _________

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

بمناسبة عيد الاضحى احب اوجه التحية لكم جميعا

السلام عليكم ورحمة الله تعالى وبركاته كل عام وانتم الى الله اقرب http://store1.up-00.com/2016-09/147276120351.swf

السلام عليكم ورحمة الله وبركاته اكتب N=N+2 بدلا من N=N+1 ثم اضف Range("A" & N) = (N - 11) / 2 قبل عبارة End With

الأخ الكريم فايز فراج السلام عليكم تم انشاء صفحة جديدة باسم رصد الدور الثانى يتم الترحيل لها . عسى ان يكون هذا هو المطلوب abo_abary_الصف الأول الإبتدائي 2016.rar

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

و عليكم السلام و رحمة الله و بركاته ... كما عودتنا دائما ... تغيب تغيب و تجيبلنا مفاجأة من العيار الثقيل ... سلمت يداك و زادك الله من علمه ...

ماشى يا كبيرنا مش بقولك مبتدأ فى اول الطريق

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

انت رائع ،، قمت وبنفس الطريقة بتسجيل مايكرو واعطاني نفس الكود. جزاك الله خيرا ،،

بعد اذن اخي ابو حنين نفس العمل لكن بالمعادلات ضع هذه المعادلة في الخلية D2 واسحب نزولاً =IF(MAX($D$1:D1)+1>$A$1,"",IF(MOD((ROWS($A$1:A1)-1),3)<>0,"",MAX($D$1:D1)+1)) للتوضيح المرفق في الحالة العامة (المرفق ) يجب وضع هذه المعادلة في الخلية D2 عندها يمكن تغيير القيمتين في A1 & F1 =IF(MAX($D$1:D1)+1>$A$1,"",IF(MOD((ROWS($A$1:A1)-1),$F$1+1)<>0,"",MAX($D$1:D1)+1)) تسلسل الى salim.rar

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

تم التحميل جزيت خيرا

الأخ الكريم عمر ضاحى السلام عليكم جرب المعادلة التالية ضعها فى c9 واسحبها نزولا =SUMPRODUCT(--('ALL-INF'!$I$3:$I$1000=Final!D9)*--('ALL-INF'!$E$3:$E$1000)) abo_abary_Sample.rar

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

أخي الكريم أبو سلمان ما هي الصلاحيات التي منحتها للمستخدم .. ما هي مربعات الاختيار التي قمت بالنقر عليها علامة صح في الصورة التالية يمكن استخدام السطر التالي للسماح بتنسيق الأعمدة والصفوف .. ActiveSheet.Protect Password:="123", AllowFormattingColumns:=True, AllowFormattingRows:=True

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

ياسر خليل أبو البراء اخى الفاضل ما شاء الله عليك

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

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

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

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

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

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

ريثما ترسل الملف شاهد هذا https://youtu.be/Rx4xaOs--Xs

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

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

السلام عليكم طرحت قبل عدة ايام موضوع كيف يتم حصر ايام الاجازة للموظف . ولم احصل على جواب . ولا يعتبر هذا تقصير من قبل الاخوة الاعضاء وذلك لمشاغلهم الكثيرة ربي يعينهم على قضاء جميع حوائجهم . ولماذا لا يعتبر هذا تقصير منهم لان كل ما املك من معلومات هو منهم فكيف يبخلون وكل ما نملك منهم وفقهم الله لخدمة اخوانهم . احبتي بعد الثناء على الله جل في علاه وبحمدة استطعت حل المشكلة بطريقتين الاولى بالماكرو والثانية بطريقة (VB) ولكي تعم الفائدة ارفق لكم الحل مع تمنياتي للجميع بالخير ودمتم في رعاية الله MM.rar

و عليكم السلام و رحمة الله تعالى و بركاته كل عام و الأمة الإسلامية بخير إن شاء الله

الطريقة الثانية VB.rar

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

أخي الحبيب سليم بارك الله فيك وجزاك الله كل خير بينما كنت تقدم الحل لأخونا محمد السباعي كنت منهمك في الكود التالي (الذي تعدى معي حد الجنون ..!! أكثر من ساعة ونصف وربما ساعتين في هذا الكود) هو كود مجنون بحق .. حاولت فيه بقدر المستطاع أن أجعله كون مرن يصلح لأي موضوع شبيه بهذا الموضوع (خصوصاً أن هذا الموضوع يتكرر في كثير من الأحيان) وهو أن يكون هناك ورقة عمل رئيسية بها عمودوالمطلوب ترحيل القيم في هذا العمود إلى الورقة المناسبة ، وأضفنا إليه من قبل إمكانية إنشاء ورقة عمل إذا لم تكن موجودة .. الكود المجنون من العيار الثقيل وأرجو أن يبدي الأعضاء أي ملاحظات عليه لتطويره بحيث يصلح لهذه المشكلة أياً كان شكلها وحجمها وأبعادها ... الكود بالشكل التالي Sub Transfer_Data_Using_Filter_By_List() 'Author : YasserKhalil 'Release : 01 - 09 - 2016 '------------------------ Dim dictPerson As Object, dictSheet As Object, mtx(), isFound As Boolean Dim I As Long, v1 As Variant, v2 As Variant, arr As Variant, arrCol As Variant Dim rng As Range, arrHeader As Variant Dim cnt As Integer, counter As Integer Dim Rc As Long, Gc As Long, Bc As Long '=========================================================================================== 'Column Number To Be Filtered Const iCol As Integer = 5 'Sheet Name (The Source Sheet) Const sSheet As String = "DATA" 'Data Range Including Header Set rng = Sheets(sSheet).Range("A5:E" & Sheets(sSheet).Cells(Rows.Count, iCol).End(xlUp).Row) 'Row Number For Destination Sheets (5 = Row 5) Const destRow As Integer = 5 'Column Number For Destination Sheets (1 = Column A) Const destCol As Integer = 1 'Column Widths For Output Sheets arr = Array(14, 50, 15, 14) 'Columns Order To Be Copied. So Column 4 In Data Sheet To Be Copied To Column 1 To Destination Sheet arrCol = Array(4, 3, 1, 2) 'Columns Order To Be Copied. So Column 4 In Data Sheet To Be Copied To Column 1 To Destination Sheet arrHeader = Array("القيمة", "البيان", "التوجيه المحاسبي", "التاريخ") '=========================================================================================== Application.ScreenUpdating = False mtx = rng.Value Set dictPerson = CreateObject("Scripting.Dictionary") For I = 2 To UBound(mtx, 1) If Not dictPerson.Exists(mtx(I, iCol)) Then dictPerson.Add mtx(I, iCol), mtx(I, iCol) Next I Set dictSheet = CreateObject("Scripting.Dictionary") For I = 1 To Worksheets.Count If Not dictSheet.Exists(Worksheets(I).Name) Then dictSheet.Add Worksheets(I).Name, Worksheets(I).Name Next I dictSheet.Remove (sSheet) For Each v1 In dictPerson isFound = False For Each v2 In dictSheet If v1 = v2 Then isFound = True Exit For End If Next v2 If Not isFound Then If MsgBox(v1 & " Does Not Exist." & vbCrLf & "Create This Sheet ? ", vbOKCancel) = vbOK Then Worksheets.Add After:=Sheets(sSheet) ActiveSheet.Name = v1 ActiveSheet.DisplayRightToLeft = True Else dictPerson.Remove v1 End If End If Next v1 For Each v1 In dictPerson Sheets(v1).Cells.Clear rng.AutoFilter Field:=iCol, Criteria1:=v1 With rng.Offset(1) For counter = LBound(arrCol) To UBound(arrCol) .Columns(arrCol(counter)).SpecialCells(xlCellTypeVisible).Copy Sheets(v1).Cells(destRow + 1, destCol + counter).PasteSpecial xlPasteValues Sheets(v1).Columns(destCol + counter).NumberFormat = .Columns(arrCol(counter)).NumberFormat Next counter Sheets(v1).Cells(destRow, destCol).Resize(1, UBound(arrHeader) + 1).Value = arrHeader End With With rng(1, 1) Rc = .Interior.Color Mod 256 Gc = Int(.Interior.Color / 256) Mod 256 Bc = Int(Int(.Interior.Color / 256) / 256) Sheets(v1).Cells(destRow, destCol).Resize(1, UBound(arrHeader) + 1).Interior.Color = RGB(Rc, Gc, Bc) End With With Sheets(v1) With .Cells .ReadingOrder = xlRTL .Font.Name = "Arial" .Font.Size = 11 .HorizontalAlignment = xlCenter: .VerticalAlignment = xlCenter .RowHeight = 19 .ColumnWidth = 9 End With With .Cells(destRow - 1, destCol) .Offset(1).CurrentRegion.Borders.Value = 1 .Value = v1 .Resize(1, UBound(arrHeader) + 1).Interior.Color = vbYellow .Resize(1, UBound(arrHeader) + 1).HorizontalAlignment = xlCenterAcrossSelection End With With .Rows(destRow - 1).Resize(2) .RowHeight = 25 .Font.Bold = True .Font.Size = 13 End With For cnt = LBound(arr) To UBound(arr) .Columns(destCol + cnt).ColumnWidth = arr(cnt) Next cnt Application.Goto .Range("A1") End With Next v1 Application.Goto Sheets(sSheet).Range("A1") rng.AutoFilter Application.CutCopyMode = False Application.ScreenUpdating = True MsgBox "Done...", 64 End Sub فمت بوضع التعليقات باللغة الإنجليزية (معلش تعود مش أكتر) سأقوم بشرحها لمن يهمه الأمر أول سطر في التعليق يتعلق برقم العمود الذي يحتوي على القيم التي سيتم فلترتها السطر التالي يكتب اسم ورقة العمل التي تحتوي على البيانات (الورقة الرئيسية) السطر التالي نطاق البيانات المراد العمل عليها السطر التالي رقم الصف المراد وضع البيانات فيه السطر التالي رقم العمود المراد وضع البيانات فيه .. مثال لو أردنا وضع البيانات في الخلية H3 هذا يعني أن رقم الصف هو 3 ورقم العمود هو 8 السطر التالي عرض الأعمدة في المخرجات ..بما أننا تعاملنا في المخرجات مع 4 أعمدة فيكتب 4 أرقام ..يمكنك ببساطة زيادة أو نقصان العدد السطر التالي ترتيب الأعمدة وهذا السطر مهم للغاية ..فقد لاحظت أن الترتيب ليس بالضبط كترتيب الورقة الرئيسية وهذا ما دفعني إلى كتابة الكود في الحقيقة .. المهم هنا الرقم 4 هو رابع عمود في ورقة البيانات ، والرقم 3 هو ثالث عمود في ورقة البيانات ، والرقم 1 أول عمود في ورقة البيانات ، والرقم 2 هو ثاني عمود في ورقة البيانات ، وسيتم ترحيلهم بنفس الترتيب إلى الأوراق الجديدة السطر التالي هو خاص بالعناوين التي ستوضع في الأوراق الأخرى والتي سيتم ترحيل البيانات إليها ، وقد قمت بذلك أيضاً لأنني لاحظت أن هناك تغيير في العناوين (العمود "مدين" يسمى في المخرجات باسم "القيمة") المهم الأربعة سطور الأخيرة يجب أن يكون كل منها محتوي على 4 عناصر حسب عدد الأعمدة المطلوبة في المخرجات أسأل الله العظيم أن يكون الكود مفيد لكم وأعتذر عن الإطالة .. ولكن كان لابد من التوضيح التام لما هو مهم في الكود لتتمكنوا من استخدامه بسهولة ويسر .. لتجربة الكود بشكل أعمق اختر في الخلية E12 ايصال تسوية ، وهي ورقة عمل غير موجودة لتشاهد ورقة العمل وهي تنشأ وتوضع فيها البيانات .. ولك الحرية في تلك النقطة (لك أن تنشيء ورقة العمل أو تلغي ... لابد أن يكون هناك مرونة) تقبلوا وافر تقديري واحترامي رابط الملف المرفق من هنا

شكرا لك اخي الفاضل

السلام عليكمعلى الوعد نلتقىفى يوم الجمعة المباركمع فيديوهات شرح موضوعات احترافية فى قواعد بيانات أكسيسيمكنكم تطبيق الشرح على أكسيس 2010 20132016فالجوهر واحدو إن اختلف الشكلفيديو اليومتريد أن تنتقل بين السجلات ليس بمقدار سجل واحد للأمام و سجل للخلفبل بمقدار عدد من السجلات تحدده أنتهذا الفيديو هو طلبكمع الكود البسيطالفيديوhttps://youtu.be/I3e3O_xG5C8

أو حل آخر جرب هذا الملف Remove Library References.rar

شد انتباهي هذا الموضوع طلب معادلة ترجمه أسماء الأشخاص ولما كان هذا الملف في مكتبتي احببت ان يستفيد منه الاخوة الكرام الملف عبارة عن وظيفة اضافية عليك اولا اضافته الى ملفك Translation Names .rar و هذا شرح فيديو لكيفية عمل الملف Translation Names.rar