حسين مامون

السلام عليكم استادي سليم حاصبيا دائما كعادتك لا تبخل علينا عملك ممتاز جزاك الله خيرا

استاذ احمد زمان لو سمحت ممكن شرح دور Q2 في الكود

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

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

السلام عليكم استاذ خالد الرشيدي الف الف شكر عمل رائع وممتاز هذا ما اريد جزاك الله خيرا تحياتي

للرفع

السلام عليكم ورحمة الله تقبل الله منا ومنكم صيام رمضان المبارك عندي في هذا الملف فورم واريد عند ادخال اول حرف في اي اسم ب textbox1 تظهر النتيجة في listbox1 دون تغيير الكود الحالي في listbox1 جزاكم الله خيرا listbox.rar

جزاك الله خيرا استاذ عماد

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

نعم اخي شاهدت الفيديو ومن خلاله توصلت الى حل على كل حال الفضل يعود الى الله اولا والي حضرتك الحمد لله الف الف شكر لك استاذي

اخي اشكرك حلت المشكلة غيرة رقم العمود من 4 الى 1 If arr(i, 4) = Range("K5") Then If arr(i, 1) = Range("K5") Then جزاك الله خيرا

اخي اشكرك على الاهتمام جربت الكود لم يعد يعمل يبحث حتى على الارقام الموجودة في العمود a في كل بحث يعطي رسالة "Invalid Criteria"

السلام عليكم ورحمة الله اولا اود ان اشكر استاذنا ياسر خليل ابو البراء وكذلك الاستاذ ناصر سعيد بعذ ادن الاخ ياسر خليل ابو البراء قمت بتعديل بسيط للكود يعني الكود يفلتر البيانات حسب الخلية K5 في الشيت2 ولكن عند ادخال رقم غير موجود في الخلية K5 تحدث مشاكل . استاذ ياسر خليل .... فضلا ما حل هذه المشكة ؟ ' قمت بالغاء هذا السطر في الكود If arr(i, 3) Like "*" & "äÇ*" & "*" Then واضفت هذا السطر If arr(i, 1) = Range("k5") Then بحث بشرط.rar

اشكرك اخي هذا عمل ممتاز جعله الله في ميزان حسناتك جزاك الله خيرا

السلام عليكم ورحمة الله اساذي سليم حاصبيا ارجو ان تقبل اعتذاري لتأخري في الرد وذلك لاسباب شخصية في المرفق شرح لما اريد وارجو ان يكون كافيا جزاك الله خيرا Nouveau Archive WinRAR (5).rar

السلام عليكم ورحمة الله استاذنا سليم حاصبيا الف شكر الكود يعمل ولكن يحتاج الى تعديل ، لانه لاينسخ جميع البيانات فمثلا الصفحة 1 العمود j فيه 17 قيمة نسخ منها 15 قيمة فقط وكذلك باقي الصفحات لو سمحت ممكن تعيل الكود وشرح التعديل جزاك الله خيرا

السلام عليكم ورحمة الله عندي في الملف المرفق شيتات مرقمة من 1 الى غير محدد واريد ان شاء الله ما يلي 1- ادا كان العمود(j)فيه بيانات من كل صفحة ينسخها مع العمود (h)وكذلك الخلية(b1) 2- اضافة صف فارغ ملون بين اسم واخر كما في النمودج 3- تلصق البيانات في صفحة الديون المدى(e4:g) جزاكم الله خيرا Nouveau Archive WinRAR (4).rar

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

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

استاذي ياسر خليل أبو البراء جربته وهو يعمل انظر المرفق Nouveau Archive WinRAR (3).rar

ان شاء الله ساتحقق وارسل النتيجة

السلام عليكم استاذي المحترم خليل ابو البراء بعذ ادنك حالولت كثيرا مع الكود والحمد لله توصلت الى حل يعني كما طلبت في المشاركة الاخيرة اريد منك وبكل احترام اجابتي هل الكود صحيح هكذا ام انه عكس ذلك جوابك مهم بالنسبة الي لاني لست خبيرا في هذا Sub Test2() Dim ws As Worksheet Dim sh As Worksheet Dim rngDates As Range Dim rngTotal As Range Dim rngFine As Range Dim rngFine2 As Range Application.ScreenUpdating = False Set sh = Feuil1 For Each ws In ThisWorkbook.Worksheets If ws.Name <> "الرئيسية" And ws.Name <> "namodaj" And ws.Name <> "طباعة" Then If ws.Name <> sh.Name Then If ws.Range("g9").Value <> "" Then ws.Range("g9:j" & ws.Cells(Rows.Count, "g").End(xlUp).Row).Copy Feuil1.Cells(Rows.Count, 9).End(xlUp).Offset(1).PasteSpecial xlPasteValues End If End If End If Next ws Application.CutCopyMode = False If sh.Range("I2").Value = "" Then Exit Sub Set rngDates = sh.Range("I2:I" & sh.Range("I2").CurrentRegion.Rows.Count + 1) Set rngTotal = sh.Range("J2:J" & sh.Range("J2").CurrentRegion.Rows.Count + 1) Set rngFine = sh.Range("k2:k" & sh.Range("k2").CurrentRegion.Rows.Count + 1) Set rngFine2 = sh.Range("L2:L" & sh.Range("L2").CurrentRegion.Rows.Count + 1) With sh.Range("E4:E" & sh.Cells(Rows.Count, 4).End(xlUp).Row) .Formula = "=SUMPRODUCT(--(MONTH(" & rngDates.Address & ")=MONTH(D4))*(YEAR(" & rngDates.Address & ")=YEAR(D4)),--(" & rngTotal.Address & "))" .Offset(, 1).Formula = "=SUMPRODUCT(--(MONTH(" & rngDates.Address & ")=MONTH(d4))*(YEAR(" & rngDates.Address & ")=YEAR(d4)),--(" & rngFine.Address & "))" .Offset(, 2).Formula = "=SUMPRODUCT(--(MONTH(" & rngDates.Address & ")=MONTH(d4))*(YEAR(" & rngDates.Address & ")=YEAR(d4)),--(" & rngFine2.Address & "))" '.Offset(, 2).Formula = "=SUM(E4:F4)" .Resize(, 3).Value = .Resize(, 3).Value End With sh.Columns("I:M").ClearContents Application.Goto sh.Range("A1") Application.ScreenUpdating = True End Sub جزاك الله خيرا

الف الف شكر استاذ نعم فهمت هذا ولكن انا اتكلم عن تغيير المدى في الشيتات المرقمة انظر المرفق في مشاركتي السابقة ، تم نقل البيانات في كل الصفحات الى مدى g9:j تشكر

استاذي المحترم خليل ابو البراء السلام عليكم ورحمة الله ماذا نغير في الكود ادا اصبح المدى في شيتات من g9:j (فقط لاستفاذة) تحياتي Nouveau Archive WinRAR (2).rar

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