ابوحمزه المصرى

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

up

مع المحاولات قد اكون اقتربت من الحل لكن اليكم كود التجربه لكن للاسف لا يعمل ولكن اطرحه كى نساعد بعضنا البعض فى طريقة الحل لعل احد يرى مالا اراه فى الكود Sub auto_filtr() Dim asd(0 To 4) Dim asdS(0 To 4) Dim i As Integer Dim J As Integer asd = Array(Range("A1"), Range("B1"), Range("C1"), Range("D1"), Range("E1")) asdS = Array(ListObjects("الجدول1"), ListObjects("الجدول2"), ListObjects("الجدول3"), ListObjects("الجدول4"), ListObjects("الجدول5")) For asd(i) = LBound(asd) To UBound(asd) For asdS(J) = LBound(asdS) To UBound(asdS) ActiveWorkbook.Worksheets("ورقة1").asdS.Sort.SortFields.Clear ActiveWorkbook.Worksheets("ورقة1").asdS.Sort.SortFields.Add _ Key:=asd(i), SortOn:=xlSortOnValues, Order:= _ xlAscending, DataOption:=xlSortNormal With ActiveWorkbook.Worksheets("ورقة1").asdS.Sort .Header = xlYes .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With Next i Next J End Sub

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

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

اخى ياسر شكرا على كل جديد ومفيد .. انت دائما مبدع

الا يوجد حل

السلام عليكم ورحمة الله وبركاته اخوانى اعضاء اوفيسنا هذا الكود مسبب بطء فى الملف وعند البدء فى التشغيل لعلى اجد اختصار له لتسريع الامر باستخدام ARRAY مثلا اليكم الملف للتعديل Sub autofiltr() ActiveWorkbook.Worksheets("ورقة1").ListObjects("الجدول1").Sort.SortFields.Clear ActiveWorkbook.Worksheets("ورقة1").ListObjects("الجدول1").Sort.SortFields.Add _ Key:=Range("الجدول1[[#All],[القاهرة]]"), SortOn:=xlSortOnValues, Order:= _ xlAscending, DataOption:=xlSortNormal With ActiveWorkbook.Worksheets("ورقة1").ListObjects("الجدول1").Sort .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With ActiveWorkbook.Worksheets("ورقة1").ListObjects("الجدول2").Sort.SortFields.Clear ActiveWorkbook.Worksheets("ورقة1").ListObjects("الجدول2").Sort.SortFields.Add _ Key:=Range("الجدول2[[#All],[اسيوط ]]"), SortOn:=xlSortOnValues, Order:= _ xlAscending, DataOption:=xlSortNormal With ActiveWorkbook.Worksheets("ورقة1").ListObjects("الجدول2").Sort .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With ActiveWorkbook.Worksheets("ورقة1").ListObjects("الجدول3").Sort.SortFields.Clear ActiveWorkbook.Worksheets("ورقة1").ListObjects("الجدول3").Sort.SortFields.Add _ Key:=Range("الجدول3[[#All],[المنيا]]"), SortOn:=xlSortOnValues, Order:= _ xlAscending, DataOption:=xlSortNormal With ActiveWorkbook.Worksheets("ورقة1").ListObjects("الجدول3").Sort .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With ActiveWorkbook.Worksheets("ورقة1").ListObjects("الجدول4").Sort.SortFields.Clear ActiveWorkbook.Worksheets("ورقة1").ListObjects("الجدول4").Sort.SortFields.Add _ Key:=Range("الجدول4[[#All],[قنا]]"), SortOn:=xlSortOnValues, Order:= _ xlAscending, DataOption:=xlSortNormal With ActiveWorkbook.Worksheets("ورقة1").ListObjects("الجدول4").Sort .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With ActiveWorkbook.Worksheets("ورقة1").ListObjects("الجدول5").Sort.SortFields.Clear ActiveWorkbook.Worksheets("ورقة1").ListObjects("الجدول5").Sort.SortFields.Add _ Key:=Range("الجدول5[[#All],[اسوان]]"), SortOn:=xlSortOnValues, Order:= _ xlAscending, DataOption:=xlSortNormal With ActiveWorkbook.Worksheets("ورقة1").ListObjects("الجدول5").Sort .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With End Sub array.rar

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

هل من الممكن اضافة استدعاء لفاتورة والتعديل عليها

الف الف مبروك ومن نجاج الى نجاح وتوفيق

أخي الغالي ضاحي بارك الله فيك وجعله بميزان حسناتك ... دائما رائع ولاننتظر منك الا الاعمال الرائعه

ممكن كلمة المرور

تسلم الايادى اللى بتعمل برمجه بتنادى ... تحيه للصعايده الجدعان واولهم الاستاذ مختار

لترحيل المدى المطلوب sheets(2).range("a1:z12").value = sheets(1).range("a1:z12").value

السلام عليكم اخوانى اعضاء اوفيسنا الكرام .... كل عام وانت بخير بمناسبة عيد الاضحى المبارك اعاده الله على الامه الاسلاميه بالخير والنصر والتمكين لديننا الحنيف اليوم اقدم لكم موضوع ربما يكون بسيط لكن قد يحتار البعض فى الوصول للحل عند الاحتياج وهو تحويل التاريخ من ميلادى الى هجرى بتحويل نوع البيان من dd/mm/yyyy الى B2dd/mm/yyyy .

اظن الحل هو تقوم بترحيل البيانات المطلوبه فى شيت مستقل ثم الحفظ

شرح رائع من صقر اروع

انا طبقت المثال ....فعلا قمة فى الروعه وشرح متميز ... بارك الله فيك وزادك علما نافعا

السلام عليكم ورحمة الله وبركاته بما ان اخوكم ضعيف فى لغة VBA استحملونى عشان هاشرحلكم اليوم طريقة تسريع الكود فى حالة بطء تنفيذ الكود هناك ثلاثة اوامر لتسريع تنفيذ الامر يتم كتابتها قبل الكود ويتم الغاء الاوامر بعد الكود اولا قبل الكود إيقاف وميض الشاشة Application.screenupdating=False إيقاف الحساب التلقائي Application.calculation=xlCalculationManual إيقاف الأحداث التلقائي Application.EnableEvents=False ثانيا بعد الكود نكتب الثلاث اوامر لاسترجاع تنفيذ العمليات اعادة تشغيل وميض الشاشة Application.screenupdating=true اعادة تشغيل الحساب التلقائي Application.calculation=xlCalculationAutomatic اعادة تشغيل الأحداث التلقائي Application.EnableEvents= true ارجوا ان اكون وفقت فى الشرح ولمن يريد الاضافة من عمالقة المنتدى يتقدم

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

السلام عليكم ورحمة الله وبركاته كل عام وانتم بخير هل يمكن تطبيقها على الموضوع التالى http://www.officena.net/ib/topic/63494-اضافة-على-قائمة-منسدلة-مرتبة-ابجديا-ومعتمده-على-قائمة-اخرى-وتقبل-الزيادة/

تفضل اخى لعله الحل المطلوب ترحيل حسب الترتيب التصاعدى للتاريخ بشرط الفتره المحدده .rar

up

السلام عليكم ورحمة الله وبركاته اليوم الأول اختصار مهم لسرعة الادخال