كيف يمكن البحث عن أكبر قيمة في كل أوراق العمل ثم إضافة 1 في ورقة العمل الجديد في نفس الخلية

[بوعبد الله محفوظ]

السلام عليكم ورحمة الله تعالى وبركاته

كيف يمكن البحث عن أكبر قيمة في كل أوراق العمل ثم إضافة 1 في ورقة العمل الجديد في نفس الخلية

عندي ورقة عمل اسمها نقد

في الخلية D2 وضعت الكود التالي 

=TODAY()

أما في الخلية D3 قمت بوضع الكود التالي

=1&"/"&YEAR(D2)

عندما أريد إنشاء ورقة عمل جديدة أقوم بالضغط باليمين على ورقة العمل نقد ثم أختر "Move or copy" ثم "create a copy"  مع تحديد "Move to end"

أريد عند إنشاء ورقة عمل جديد يقوم بالبحث في كل أوراق العمل عن أكبر قيمة للخلية D3 ثم يقوم بإضافة رقم واحد في ورقة العمل الجديدة

بارك الله فيكم وفي علمكم

فاتورة 2016.rar

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

أخي الكريم بو عبد الله

جرب الكود التالي عله يفي بالغرض

Sub CreateNewSheet()
    Dim Ws As Worksheet, Y As Integer, X
    
    For Each Ws In ThisWorkbook.Worksheets
        X = Val(Mid(Ws.Range("D3").Formula, 2, 1))
        If Y > X Then Y = Y Else Y = X
    Next Ws
    
    Sheets("نقد").Copy After:=Sheets(Sheets.Count)
    ActiveSheet.Range("D3").Formula = Replace(ActiveSheet.Range("D3").Formula, Val(Mid(ActiveSheet.Range("D3").Formula, 2, 1)), Y + 1)
End Sub

تقبل تحياتي

[سليم حاصبيا]

Sub salim()
    
    Dim My_date As Date
   
Sheet1.Copy After:=Sheets(Sheets.Count)

t = Sheets.Count
ActiveSheet.Name = Sheet1.Name & "" & t

ActiveSheet.Range("D2").Formula = "=today()"

 My_date = ActiveSheet.Range("d2").Value
 My_year = Year(My_date)
 
 ActiveSheet.Range("D3").Formula = "'" & t & "/" & My_year
End Sub

بعد إذن اخي وصديقي ياسر

هذا الكود  دون ذكر اسماء الصفحات تفادياً لمشاكل اللغة العربية

مع تحباتي

تم تعديل يناير 22, 2016 بواسطه سليم حاصبيا

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

أخي الحبيب سليم

بارك الله فيك على هذا التميز والإبداع

بالنسبة للكود خاصتك اعتمدت على عدد أوراق العمل في القيمة الجديدة أي إنك اعتمدت على Sheets.Count ..

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

[بوعبد الله محفوظ]

مشكوووووووووووووريييييييييييييييييييين على الاهتمام

أستاذنا الغالي ياسر خليل أبو البراء

للأسف الكود لم يعمل

وضعته في "thisworkbook" و "sheet1 نقد" لكن للأسف كانت النتيجة واحدة

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

أخي الكريم يوضع الكود في موديول جديد ..

لتنفيذ الكود اضغط  Alt + F8  من لوحة الفاتيح واختار اسم الماكرو CreateNewSheet ..

يمكنك معرفة البدايات من خلال الرابط التالي

بداية الطريق لإنقاذ الغريق

[سليم حاصبيا]

جرب هذا الملف

 

add_sheet with a vriable Num.rar

[بوعبد الله محفوظ]

أستاذنا أبو البراء

أستاذنا سليم حاصيبا

كلا الكودين يعملان

لكن ظهرت مشكلة جديدة عند الوصول إلى رقم 10 يبقى يتكرر "10"

تم تعديل يناير 22, 2016 بواسطه بوعبد الله محفوظ

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

أخي الكريم جرب التعديل التالي

Sub CreateNewSheet()
    Dim Ws As Worksheet, Sh As Worksheet, Str As String, Y As Integer, X
    
    Set Sh = Sheet1
    
    For Each Ws In ThisWorkbook.Worksheets
        Str = Ws.Range("D3").Formula
        X = Val(Mid(Str, 2, InStr(Str, "&") - 1))
        If Y > X Then Y = Y Else Y = X
    Next Ws
    
    Sh.Copy After:=Sheets(Sheets.Count)
    
    With ActiveSheet
        .Name = "نقد " & Y + 1
        .Range("D3").Formula = Replace(.Range("D3").Formula, Val(Mid(.Range("D3").Formula, 2, InStr(.Range("D3").Formula, "&") - 1)), Y + 1)
    End With
    
    Sh.Activate: Sh.Range("A1").Select
End Sub

 

 

فاتورة 2016.rar

[بوعبد الله محفوظ]

بارك الله فيك أستاذنا الغالي

تم التجريب بنجاح

تم تعديل يناير 22, 2016 بواسطه بوعبد الله محفوظ