كود اضافة سطر اوتوماتكيا باضافة ورقة جديدة

[منيير]

السلام عليكم اخواني الكرام

عدت اليكم اليوم بسؤال اتمنى من الاخوة ان يجيبوني عليه ان امكن

في الملف المرفق لدي كود في الموديل المسمى NewMonthSheet اريد تعديله او بالاحرى اضافة كود عليه بحيث بالاضافة الى الدور الذي يقوم به الكود اريد كلما ضغطت مثلا على Ajouter une feuille في الورقة Août-2013 ان يتم اضافة سطر اوتوماتيكيا في الورقة المسماة Total Général قبل السطر الموجود به Total و ان يتم نسخ تفس المعادلة الموجودة في السطر الذي قبله 

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

Calcestruzzo.zip

[منيير]

هل من مجيب من الاخوان خبراء المنتدى بارك الله فيكم

[منيير]

ساعدوني اخواني الكرام بارك الله فيكم

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

الأخ الفاضل منير

مشكور على التوضيح التاااااااااام لطلبك بشكل ممتاز

هكذا يكون التوضيح

جرب الكود بهذا الشكل وإن شاء الله يفي بالغرض

Sub NewMonth_Sheet()
    Dim lSht As Worksheet
    Dim nSht As Worksheet
    Dim shName As String
    
    Set lSht = Sheets(Sheets.Count)
    
    If IsDate(lSht.Name) Then
    
    shName = Application.Proper(Format(DateAdd("m", 1, lSht.Name), "mmmm-yyyy"))
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
        On Error Resume Next 'Tests that sheet doesn't already exist
        Set nSht = Sheets(shName)
        On Error GoTo 0
        
        If nSht Is Nothing Then
        lSht.Copy after:=Sheets(Sheets.Count)
        Sheets(Sheets.Count).Name = shName
        Else
        MsgBox "Sheet """ & shName & """ already exists!", vbCritical
        End If
        Else
        MsgBox "Last sheet name does not" & Chr(10) & "represent a month!", vbCritical: Exit Sub
        End If
        For Each ce In [B9:J39]
                If ce.HasFormula = True Then GoTo 10
            ce.ClearContents
10         Next
'هذه الأسطر من الكود لتحقيق المطلوب
    Sheets("Total Général").Activate
    Range("D" & Cells(Rows.Count, 4).End(xlUp).Row - 1).EntireRow.Copy
    Range("A" & Cells(Rows.Count, 4).End(xlUp).Row).EntireRow.Insert Shift:=xlDown
    Application.CutCopyMode = False

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

تم إضافة 4 أسطر في الكود قبل آخر سطرين

تقبل تحياتي

[منيير]

بارك الله فيك اخي الفاضل ياسر خليل و لك جزيل الشكر على الجواب الشافي 

هذا بالضبط ما كنت ابحث عنه 

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

أخي الكريم منير

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

تقبل تحياتي