عمل رساله

[على حسن]

المطلوب بعد الضغط على جمع المصروفات

اعطاء رساله تم الجمع

تم تعديل أغسطس 2, 2013 بواسطه على حسن

[الـعيدروس]

ارفق مثال اخي الكريم

او الكود المراد التعديل عليه

تحياتي

[على حسن]

نصيب الشركاء

نصيب الشركاء.rar

[قنديل الصياد]

السلام عليكم

اخى واستاذى العزيز

كل عام وحضرتك بخير

اتمنى ان يكون هذا هو المطلوب

الكود بعد التعديل

Sub Macro1()
    Range("B23").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-20]C:R[-1]C)"
    Range("B23").Select
    Selection.AutoFill Destination:=Range("B23:D23"), Type:=xlFillDefault
    Range("B23:D23").Select
    Range("D23").Select
    Selection.AutoFill Destination:=Range("D23:E23"), Type:=xlFillDefault
    Range("D23:E23").Select
     MsgBox "تم الجمع . مع تحياتى: على حسن"
End Sub

مرفق ملف بعد التعديل

 

نصيب الشركاء.rar

[ضاحي الغريب]

اخي الحبيب والنشيط / قنديل الصياد

بارك الله فيك وجزاك خيرا

دائما مشاركتك جميلة ونافعة

ونفعنا واياك وكتب لنا ولكم الخير والصالحات

تقبل تحياتي

[قنديل الصياد]

شكرا لك اخى واستاذي على الكلمات الرائعة
جزاك الله خيرا

[احمد فضيله]

جزاكم الله كل خير

[قنديل الصياد]

وجزاك الله خيرااخى خير الجزاء

وكل عام وحضرتك بخير

[على حسن]

استاذنا قنديل الصياد 

جزاك الله خيرا

وزاداك الله علماً 

وجعله الله فى ميزان حسناتك

[على حسن]

اريد اضافة رسالة تم الترحيل الى هذا الكود 


Sub Shift()
Dim x(9)
Application.ScreenUpdating = False

LR = [A52].End(xlUp).Row
For r = 4 To LR
        Sheet2.Activate
        no = Cells(r, 1): nm = Cells(r, 2)
        For i = 1 To 8: x(i) = Cells(r, i + 2):  Next
        For sh = 1 To Sheets.Count
                If Sheets(sh).Name = nm Then GoTo 10
        Next sh
        
        '=====================================
        'in case no sheets in this name
            Sheets("Sample").Visible = True
            Sheets("Sample").Select
            Sheets("Sample").copy after:=Sheets(Sheets.Count)
            ActiveSheet.Name = nm
            [B1].Value = no: [B2].Value = nm
            Sheets("sample").Visible = False
        ' ======================================


10   Sheets(nm).Select
        nr = [A9999].End(xlUp).Row + 1
        For i = 1 To 8:  Cells(nr, i) = x(i): Next
20 Next r
    Columns("A:A").EntireColumn.AutoFit

Sheet2.Activate
Application.ScreenUpdating = True
[A1].Select
End Sub

Sub clrear_data()
 [A4:a51].ClearContents
 [C4:g51].ClearContents
 [i4:j51].ClearContents
 
End Sub


Private Sub Worksheet_Selectionchange(ByVal Target As Range)
If Target.HasFormula = True Then
ActiveCell.Offset(0, 1).Select
ElseIf Target.MergeCells = True And Target.HasFormula = True Then Target.Offset(0, 1).Select
ElseIf ActiveCell.HasFormula = True And ActiveCell.MergeCells = True Then ActiveCell.Offset(0, 1).Select
End If
End Sub




ActiveWindow.SmallScroll Down:=-33
    Range("C4:D51").Select
    Range("D4").Activate
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
End Sub

تم تعديل أغسطس 3, 2013 بواسطه على حسن

[ا بو سليمان]

انت رااااااااااااااااااااااااااائع   كنت ابحث عنها من زمااااان 

[ا بو سليمان]

سؤال  

 

هل بالامكان  ان تظهر الرساله تلقائي بعدما يتم الجمع بدون ضغط  على عبارة الجمع