كود اضافة مشتخلصات

[Eng Taha]

السلام عليكم اخواتى محتاج مساعدتكم فى تكملة كود 

انا كنت لقيت كود  محتاجه  فى عمل مستخلصات هندسية فى منتدى هنا و عدلته بالنسبة لشيت بتاعى فى  عايز لما اعمل مستخلص جديد ينسخلى خلايا الى باللو الاصفر  ويلصقها فى المستخلص الجديد الى باللون الاخضر  وعدم وضع  0  فى الخلايا الفارغه فى نفس (range)

ثاننيا عايز خلية  total invoice previous  

لما اعمل مستخلص جديد  ينسخ  قيمة خليه دى من المستخلص القديم

وشكرا ليكم اتمنى المساعدة

invoice 1 v3 - Copy.xlsm

[أسامة البراوى]

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

 الكود كالتالى مع مراعاة نعديل صيغ الارقام فى الخلايا واضافة سطر لتوضيح صافى المستخلص

Sub ِAdd_New_Invoice()
        
        Dim Old_Invoice
        Dim New_Invoice
        Dim Previous_Value
        Dim R
        
        
        Old_Invoice = ActiveSheet.Name
         
         '    الاحتفاظ بقيمة المستخلص الحالى لاستخدامها لاحقا
         Previous_Value = ActiveSheet.Range("D43")
        
1:      New_Invoice = InputBox("الرجاء إدخال  رقم المستخلص ", " رقم المستخلص ")
        
   'فحص المدخلات والتأكد ان المستخدم قام بادخال رقم
       If Val(New_Invoice) < 1 Then
            
           R = MsgBox("لم يتم إدخال رقم: هل تريد إعادة المحاولة ؟", vbRetryCancel)
            If R = vbRetry Then GoTo 1 Else Exit Sub
       End If
       
       
  'فحص المدخلات والتأكد من عدم تكرار اسم الشيت
      
       For Each ws In ActiveWorkbook.Worksheets
        
            If New_Invoice = ws.Name Then
                R = MsgBox(" الرقم موجود مسبقا: هل تريد إعادة المحاولة ؟", vbRetryCancel)
                If R = vbRetry Then GoTo 1 Else Exit Sub
            End If
       Next
       
        'رسالة التأكيد

           
        R = MsgBox(" لقد قمت بإدخال البيانات التالية: " & vbNewLine & "" & vbNewLine & "رقم المستخلص :  " & New_Invoice, vbOKCancel + vbQuestion + vbMsgBoxRight, "تأكيد اضافة ورقة")
       
        If R <> vbOK Then Exit Sub
        
'        البدء فى العمل
           
        ActiveSheet.Copy Before:=Sheets(1)
        
        ActiveSheet.Name = New_Invoice
              
        Sheets(New_Invoice).Range("c2").Value = New_Invoice
       
      ' نسخ قيم الخلايا فى عمود إجمالى الكميات للمستخلص السابق
      Sheets(Old_Invoice).Range("K11:K41").Copy
      
       ' لصق قيم الخلايا فى عمود الكميات السابقة للمستخلص الجديد
      
      Sheets(New_Invoice).Range("G11:G41").PasteSpecial Paste:=xlPasteValues
      
       ' مسح قيم الخلايا فى عمود الكميات الحالية للمستخلص الجديد
      
      Sheets(New_Invoice).Range("I11:I41").ClearContents
      
      ' كتابة قيمة المستخلص السابق
      Sheets(New_Invoice).Range("D44").Value = Previous_Value
      
      
      Sheets(New_Invoice).Range("D44").Select
           
   
End Sub

 

تم تعديل أبريل 17, 2018 بواسطه أسامة البراوى