مساعدة لتعديل كود اخى واستاذى المحترم سليم حاصبيا

[abouelhassan]

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

هذا الملف تصميم استاذى سليم حاصبيا 

احتاج تعديل تم عمل قائمة منسدلة بها 3 جمل-كلمات

او جملة جمع الكل وفى هذه الحالة الكود يظل كما هو حاليا يؤدى مهمته الحالية

2-الارقام السالبة اريده ان يستدعى الارقام التى اقل من صفر

3-الارقام الموجبة اريده ان يستدعى الارقام اكبر من صفر

مع خالص دعائى وشكرى وعرفانى بالجميل اخيكم باحترام

Sub Trasfer_data_Special()
  Dim R          As Worksheet, Act_sh As Worksheet
  Dim k%, col%, Ro%
  Dim Max_ro%, x%, y%
  Dim Bol        As Boolean
  Dim ST_Dat     As Date
  Dim End_Dat    As Date
  Dim My_sum#
  Dim Mot$
  
Mot = "الاجمالى"

Set R = Sheets("Report_Youmi")
Ro = R.Cells(Rows.Count, 1).End(3).Row
R.Range("C3").CurrentRegion.Resize(Ro - 1).ClearContents
R.Cells(3, 9).Resize(Ro - 2).ClearContents
ST_Dat = Application.Min(R.Range("I2:J2"))
End_Dat = Application.Max(R.Range("I2:J2"))

For k = 3 To Ro - 2

      Bol = Application.Evaluate _
        ("ISREF('" & R.Range("A" & k) & "'!A1)")
    If Bol Then
        Set Act_sh = Sheets(R.Range("A" & k) & "")

        Max_ro = Act_sh.Cells(Rows.Count, 1).End(3).Row
        For y = 3 To 7
            For x = 5 To Max_ro

                If CDate(Act_sh.Cells(x, 1)) >= ST_Dat And _
                   CDate(Act_sh.Cells(x, 1)) <= End_Dat And _
                   Act_sh.Cells(x, 2) <> Mot Then
                   My_sum = My_sum + IIf(IsNumeric(Act_sh.Cells(x, y + 2)), _
                     Act_sh.Cells(x, y + 2), 0)

               End If
               
            Next x
           R.Cells(k, y).Value = IIf(My_sum = 0, "", My_sum): My_sum = 0
       Next y
    End If
Next k
'+++++++++++++++++++++++++++++++++

R.Cells(Ro - 1, 3).Resize(, 5).Formula = _
"=if(COUNT(C$4:C$39)>0,SUM(C$4:C$39),"""")"
R.Cells(Ro, 3).Resize(, 5).Formula = _
"=IF(COUNT(C$7:C$17)>0,SUM(C$7:C$17),"""")"

R.Cells(4, 9).Resize(Ro - 3).Formula = _
"=IF(COUNT($C4:$G4)>0,SUM($C4:$G4),"""")"

R.Range("A3:I" & Ro).Value = _
R.Range("A3:I" & Ro).Value
End Sub

My_Repport_Updated.xlsm

[abouelhassan]

اذا كان الموضوع صعب 

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

اذا كانت عملية الاختيار من القائمة المنسدلة صعبة

مع خالص تحياتي