ياسر خليل أبو البراء

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

لم أفهم تلك النقطة في الحقيقة ..هلا وضحت لنا بمزيد من التفاصيل مع وضع صورة توضيحية لما تقول هل تقصد ذلك ؟؟ Sub Test() If Feuil1.Range("D19").Value > Feuil2.Cells(Rows.Count, 1).End(xlUp).Row Then Feuil1.Range("D19").Value = "": Exit Sub If Feuil1.Range("C13").Value = 0 Then Feuil1.Buttons("Button 1").Visible = False ElseIf Feuil1.Range("C13").Value > 0 And IsNumeric(Feuil1.Range("C13").Value) Then Feuil1.Buttons("Button 1").Visible = True Else MsgBox "Enter Numeric Value", vbExclamation End If End Sub

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

وعليكم السلام أخي الكريم ابراهيم ما هو منطق التقسيم .. ؟ وعلى أي أساس تتم عملية التقسيم ؟ وهل تضاف الأرقام التي يتم تقسيمها على القيمة الحالية الموجودة في النطاق B1:B6؟ هلا أرفقت لنا بعض النتائج المتوقعة ..؟

وعليكم السلام استخدم الكود التالي واربطه بزر الـ Spinner عن طريق كليك يمين ثم Assign Macro واختر اسم الماكرو Sub Test() If Range("C13").Value = 0 Then ActiveSheet.Buttons("Button 1").Visible = False ElseIf Range("C13").Value > 0 And IsNumeric(Range("C13").Value) Then ActiveSheet.Buttons("Button 1").Visible = True Else MsgBox "Enter Numeric Value", vbExclamation End If End Sub

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

من فترة قدمت موضوع يخض هذا الطلب وهو تحويل المعادلات لأكواد بأسلوب بسيط .. قد يفيدك في إنجاز المطلوب إن شاء الله http://yasserkhalilexcellover.blogspot.com/2016/05/convert-formulas-to-vba.html

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

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

أخي الكريم ناصر ... حاول استخدام الأكواد التي استخدمنا فيها المصفوفات .. راجع كود ترحيل الناجحين وغير شرط الترحيل فقط .. وإن شاء الله يظبط معاك

وعليكم السلام تم تعديل الكود السابق ..حسب ما فهمت من تعليقك الأخير حيث تم مسح المحتويات في ورقة الترحيل قبل بدء عملية الترحيل ويتم الترحيل كقيم

وعليكم السلام جرب الكود التالي عله يفي بالغرض إن شاء الله (قم بعمل التصفية كما ترغب) ثم نفذ الكود ليتم الترحيل لورقة العمل المسماة "ترحيل" إلى أول خلية فارغة في العمود الرابع D Sub Test() Dim ws As Worksheet Dim sh As Worksheet Dim lr As Long Set ws = Sheets("الحركة") Set sh = Sheets("ترحيل") Application.ScreenUpdating = False sh.Range("D12:L1000").ClearContents lr = sh.Cells(Rows.Count, 4).End(xlUp).Row + 1 ws.Range("D12:L107").SpecialCells(xlCellTypeVisible).Copy sh.Range("D" & lr).PasteSpecial xlPasteValues Application.CutCopyMode = False Application.ScreenUpdating = True End Sub

وعليكم السلام أخي الكريم حسن جرب الملف المرفق .. الحل بمعادلات الصفيف Sample.rar

ارفق ملف معبر عن المطلوب بالنسبة للأسطر الفارغة .. الكود يقوم بإظهار النتائج بدون أسطر فارغة أم أن الأسطر الفارغة لديك في البيانات الخام في الملف .. وإذا كان الأمر كذلك لما لا تقوم بحذف الأسطر الفارغة قبل تنفيذ الكود ؟!

وجزيت خيراً أخي العزيز ومشكور على دعائك الطيب ، ولك بمثله إن شاء الله

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

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

تم تعديل الكود في المشاركة رقم 2 .. لأن الاسم البرمجي مختلف في ملفك المرفق الأخير .. لذا اعتمدت في التعديل على اسم ورقة العمل Sheet1 وSheet2 النتائج بعد التنفيذ ستكون في ورقة العمل Sheet2

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

وعليكم السلام جرب الكود التالي Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$C$13" Then If Target.Value = 0 Then ActiveSheet.Buttons("Button 1").Visible = False ElseIf Target.Value > 0 And IsNumeric(Target) Then ActiveSheet.Buttons("Button 1").Visible = True Else MsgBox "Enter Numeric Value", vbExclamation End If End If End Sub

أخي الكريم ارفق الملف الذي به الخطأ .. لربما اسم ورقة العمل لديك ورقة1 وليس Sheet1 كما بالكود ، لو كان الأمر كذلك قم باستبدال Sheet1 إلى ورقة1 في أسطر الكود ، وSheet2 إلى ورقة2 .. أو ارفق الملف للإطلاع عليه

أهلا بك أخي الكريم إليك الملف التالي لللأخ يحيى حسين فيه شرح وتطبيق للدالة Index INDEX Function Tutorial.rar

الحمد لله أن تم المطلوب على خير والحمد لله الذي بنعمته تتم الصالحات تقبل تحياتي

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

السلام عليكم أخي الكريم حسام جرب الكود التالي ... Sub Test() Dim ws As Worksheet Dim sh As Worksheet Dim lr As Long Set sh = Sheet4 sh.Range("A5:F1000").ClearContents Application.ScreenUpdating = False For Each ws In ThisWorkbook.Worksheets If ws.Name <> sh.Name Then lr = sh.Cells(Rows.Count, 1).End(xlUp).Row + 1 ws.Range("A5:F" & ws.Cells(Rows.Count, 1).End(xlUp).Row).Copy sh.Range("A" & lr).PasteSpecial xlPasteValues End If Next ws Application.CutCopyMode = False Application.ScreenUpdating = True End Sub