samycalls2020

طلب أخير استاذ / سليم .. أن سمحت لى أضفت زر أخر لنفس الماكرو والمراد .. هو أن يعمل الزران معاً بنفس الماكرو ويتغير نصهما ولونهما معاً بالضغط على أى منهما . زر مزدوج2.xlsm

السلام عليكم .. هل يمكن اضافة للكود بحيث يتم تغير لون الشكل مع لون الكلمة زر مزدوج.xlsm

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

أستاذى الفاضل .. أين جملة الأستدعاء فى ماذكر من أمثله مثال هذا كود يعمل بزر Sub للتصفية() ' لنسخ حساب القائمة المنسدلة من أرصدة الى الخزينة Sheets("الخزينة").Range("H9").Value = Range("D7").Value Application.ScreenUpdating = False Dim ws As Worksheet Dim sh As Worksheet Dim lr As Long Set ws = Sheets("الخزينة") Set sh = Sheets("تصفية") Application.ScreenUpdating = False ' إلغاء الفرز والتصفية إن وجد لجدول3 Sheets("الخزينة").Range("الجدول3").AutoFilter ' تصفية للعمود 13 P Sheets("الخزينة").Range("الجدول3").AutoFilter Field:=13, Criteria1:= _ "<>" Application.ScreenUpdating = False sh.Range("D12:N11011").ClearContents lr = sh.Cells(Rows.Count, 4).End(xlUp).Row + 1 Application.ScreenUpdating = False ws.Range("D12:K11011").SpecialCells(xlCellTypeVisible).Copy sh.Range("D" & lr).PasteSpecial xlPasteValues Application.CutCopyMode = False Application.ScreenUpdating = False ' إلغاء تصفية للعمود 13 P Sheets("الخزينة").Range("الجدول3").AutoFilter Field:=13 End Sub أين تكون الأضافة حتى لايعمل أى كود أخر فى الملف وليس فى الورقة نفسها فقط سواء كان تلقائى أو بزر

الأستاذ عبد الفتاح / سلام الله عليكم مثلا لديك اكثر من ماكرو sub macro1() , sub macro2 تكتب call macro1 , call macro 2 السؤال .. أين نكتب هذا ؟ فى نفس الماكرو المطلوب استدعائه .. أم فى ماكرو منفصل وماذا إن كان هناك عدد من الماكرو تلقائى (يعمل بدون زر) وغيرهم يعمل بزر لأن المشكلة عمل عدد كبير من الماكرو فى نفس الوقت يسبب بطئ شديد

السلام عليكم .. الأخوة الكرام .. هل يوجد كود لتشغيل ماكرو محدد أو أكثر فى ملف به الكثير من الماكرو

الشكر كل الشكر للأخوة الكرام

النطاقات هى C7 :C96 , 97:C186 , C187:C306 , C307:C396 , C397:C486 , C487:C576 , C577:C666 , C667:C756 , C757:C846 , C847:936 , C937:C1026 وهى نطاقات ثابته

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

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

السلام عليكم الرجاء المساعده فى كود لنسخ أخر قيم فى نطاقات متعدده الى خلايا معينة كما فى المرفق .. نسخ أخر قيم فى نطاقات متعدده.xlsm

جزاك الله خير .. أ/ سليم

جزء أخر أرجو المساعده فيه الترتيب يتم عن طريق sh.Range("B3:U" & LRR).Sort Key1:=sh.Range("E3"), Order1:=xlAscending E3 أى عمود E ويمكن تغيره فى الكود الى G3 أو غير ذلك .. فهل من الممكن عمل عمل قائمة منسدلة فى A1 مثلاُ ويتم اختيار عمود الفرز منها

شكراً استاذنا الكريم/ سليم على وقتك وجهدك .. بارك الله فيك

أخى الأستاذ / سليم شكراً على مجهودك الكبير .. الكود به نفس المشاكل ينقل البيانات بالفراغات ( القيم الصفرية الناتجه من المعادلات ) وبدون ترتيب .. أنا قمت بمحاولة للحل أتت بنتيجة وهى موجوده بالمشاركات السابقة بأعلى .. وطلبى الأن أن سمحت لى هو وأرجو المساعده فيه الترتيب يتم عن طريق sh.Range("B3:U" & LRR).Sort Key1:=sh.Range("E3"), Order1:=xlAscending E3 أى عمود E ويمكن تغيره فى الكود الى G3 أو غير ذلك .. فهل من الممكن عمل عمل قائمة منسدلة فى A1 مثلاُ ويتم اختيار عمود الفرز منها جلب أوترحيل بيانات2.rar

جزء أخر أرجو المساعده فيه الترتيب يتم عن طريق sh.Range("B3:U" & LRR).Sort Key1:=sh.Range("E3"), Order1:=xlAscending E3 أى عمود E ويمكن تغيره فى الكود الى G3 أو غير ذلك .. فهل من الممكن عمل عمل قائمة منسدلة فى A1 مثلاُ ويتم اختيار عمود الفرز منها جلب أوترحيل بيانات2.rar

فى محاولة للحل أتت بنتيجة Sub Test3() Dim ws As Worksheet Dim sh As Worksheet Dim lr As Long Set ws = Sheets("DATA") Set sh = Sheets("AS") Application.ScreenUpdating = False sh.Range("B3:U1026").ClearContents lr = sh.Cells(Rows.Count, 1).End(xlUp).Row + 2 ws.Range("B7:U1026").Copy sh.Range("B" & lr).PasteSpecial xlPasteValues LRR = sh.Cells(Rows.Count, 4).End(xlUp).Row + 1 sh.Range("B3:U" & LRR).Sort Key1:=sh.Range("E3"), Order1:=xlAscending On Error Resume Next sh.Columns(5).Replace 0, "" sh.Columns(5).SpecialCells(xlCellTypeBlanks).EntireRow.Delete On Error GoTo 0 Application.CutCopyMode = False Application.ScreenUpdating = False 'ÊÓØíÑ ÌÏæá ÇáÈíÇäÇÊ ÇáÊí Êã ÌáÈåÇ Range("B3").CurrentRegion.Borders.Value = 1 End Sub

للرفع

الأستاذ الكبير / سليم كل الشكر على المشاركة الكود يعمل ولكن ينقل البيانات بالفراغات وبدون ترتيب .. فهل من الممكن التعديل على الكود الأساسى Sub Test3() Dim ws As Worksheet Dim sh As Worksheet Dim lr As Long Set ws = Sheets("DATA") Set sh = Sheets("AS") Application.ScreenUpdating = False sh.Range("B3:U1026").ClearContents lr = sh.Cells(Rows.Count, 1).End(xlUp).Row + 2 ws.Range("B7:U1026").SpecialCells(xlCellTypeVisible).Copy sh.Range("B" & lr).PasteSpecial xlPasteValues LRR = sh.Cells(Rows.Count, 4).End(xlUp).Row + 1 sh.Range("B3:U" & LRR).Sort Key1:=sh.Range("E3"), Order1:=xlAscending On Error Resume Next sh.Columns(5).Replace 0, "" sh.Columns(5).SpecialCells(xlCellTypeBlanks).EntireRow.Delete On Error GoTo 0 Application.CutCopyMode = False Application.ScreenUpdating = False 'ÊÓØíÑ ÌÏæá ÇáÈíÇäÇÊ ÇáÊí Êã ÌáÈåÇ Range("B3").CurrentRegion.Borders.Value = 1 End Sub

السلام عليكم .. معى ملف لجلب بيانات بدون فراغات مع الترتيب الأبجد من جدول MM لكن فى حالة عمل تصفية للجدول MM لأى عمود مثلاً E "الاسم" لأختيار أسماء محدده فى ورقة DATA , وعندجلب الأسماء بالكود فى ورقة AS يجلب ما تم تصفيته . المطلوب هو أن يقوم الكود بجلب جميع بيانات الجدول كما هو دون النظر الى التصفية .. مع احترامى .. جلب أوترحيل بيانات.rar

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

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

اليك ما طلبت بمعنى أنه إذا نساوى الطرف الدائن والطرف المدين للحساب لنفس العميل لن يتم جلبه والكود يقوم بعمله جيداً .. وكل ما أريدة هو أن تكون الأرقام المرحله كما هى .. سوء كانت صحيحه أو بها كسور ww.xlsm

السلام عليكم .. هذا كود لجلب بيانات حساب بشرط عدم تساوى طرفىه القيم المجلوبه للحساب المحدد لاتعطى الكسور المراد : تعديل الكود لجلب الأرقام كما هى أن كانت صحيحة أو بها كسور w.xlsm

شكراً أ / نبيل على تعاونكم