حسين مامون

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

ماشاء الله عليك استاد اكرمك الله

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

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

اللهم يسر ولا تعسر

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

تم اضافة فورم اخر لمخزون الاحبار red.cartier.xlsxتعديل55.xlsm

تفضل جرب طباعة جماعية red.cartier.xlsxتعديل55.xlsm

اخي الكريم يعمل في جهازي بكفاءة تقسيط .xlsm

اهلا بك اخي اجيبك من الهاتف سارى طلبك لاحقا

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

تفضل اخي الكريم red.cartier.xlsxتعديل55.xlsm

هذه محاولة ان لم يعجبك انتظر احد الاساتدة ليجيبك Option Explicit Sub copy_list() Dim ws1 As Worksheet Dim ws2 As Worksheet Dim lr, x, r Dim rng1 Dim rng2 Application.ScreenUpdating = False Set ws1 = Sheets("main") Set ws2 = Sheets("list") With ws2 .Range("b6:c10000").ClearContents Set rng1 = .Range("g5") Set rng2 = .Range("i5") If rng1 = "" Or rng2 = "" Then Exit Sub r = 6 lr = ws1.Cells(Rows.Count, "c").End(xlUp).Row For x = 3 To lr Select Case ws1.Cells(x, "c").Value2: Case rng1 To rng2 .Range("b" & r).Resize(1, 2).Value = ws1.Cells(x, "c").Resize(1, 2).Value r = r + 1 End Select Next x End With Application.ScreenUpdating = True End Sub aaaa.xlsm

قم بتجربة المرفق في اضافات اخرى لو فيه خلل رد علي red.cartier.xlsxتعديل55.xlsm

السلام عليكم تم تعديل على فورم6 ويشمل التعديل زر (تعديل) و زر (حدف) انظر المرفق ملاحظة يجب تعديل الليستبوكس لكي يبحث برقم الفاتورة لان التاريخ يمكن ان يتكرر eloony.rar

وجزيت بمثل ما دعوت لي الحمد لله والشكر وحفظك الله في القادم نعمل على اضافة بيانات المخزون وطباعته تحياتي انظر المرفق هناك زر اضافة بيانات المخزون لاظهار فورم ان اعجبك red.cartier.xlsxتعديل55.xlsm

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

جرب المرفق ان لم يعمل فاظن ان المشكل في النظام لديك Total.xlsm

شغال عندي 100/100

جرب المرفق اجمالي.xlsm

اخي الكريم اهلا وسهلا جرب المرفق او انسخ الماكرو وضعه في ملفك لعله ما تريد Sub imrimer_tous() Dim sh As Worksheet Application.ScreenUpdating = False For Each sh In ThisWorkbook.Worksheets If sh.Name <> "رئيسة" Then GoTo 1 sh.Range("a1:h15").PrintOut 1: Next sh Application.ScreenUpdating = True End Sub طباعة جميع الشواهد.xlsm

غير الماكرو بهذا Sub TEST() Dim lr With Sheets("HR") lr = .Cells(Rows.Count, 1).End(3).Row + 1 If Application.WorksheetFunction.CountIf(.Range("A5:A10000"), .Range("y1")) > 0 _ Then MsgBox "الرقم الذي ادخاله موجود في القائمة", vbInformation: Exit Sub If .[y1] = "" Then Exit Sub .Range("a" & lr).Value = .[y1].Value .Range("e" & lr).Resize(1, 31).Value = .Range("am6").Resize(1, 31).Value End With End Sub

اخي الكريم ملاحظة : تغيير اسماء الشيتات يعمل مشكل في اكواد VBA سميها كما ستبقى دائما لكي لا نضطر لاعادة تعديل الاكواد تحياتي جرب الطباعة ورد علي red.cartier.xlsxتعديل55.xlsm

بالنسبة للطباعة هل تقصد هكذا

تفضل جرب المرفق INI.xlsm