كود جمع خلايا من عدة شيتات (مساعدة )

[محمد عبد الناصر]

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

فى الملف المرفق فى شيتات من 1 الى 12 عايز كود يجمعلى مصورف كل عامل فى الشركة يعنى العامل رقم 1 فى الشيت رقم 1 اسمو محمود عايز كود جمع مصاريف الموظف محمود ده فى الشيت 1 الى الشيت 12 يعنى اخد فلوس كام فى السنه كلها  والكود يطبق على كل الموظفين فى الشيت Total

MD.rar

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

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

اكتب هذه المعادلة في C7  و اسحب نزولاً

=SUM('1:12'!F8:AJ8)

 

[محمد عبد الناصر]

المشكلة حضرتك لو مثلا مسحت الشيت رقم 12 وضفتو تانى مش بيحسبو

لان فى البداية الشيت ده مش بيكون موجود عايزها فى كود مكرو عشان الشيتات فى البداية مش بتكون موجوده

[محمد عبد الناصر]

فينك يا استاذ ياسر خليل يارب تشوف موضوعى

[محمد عبد الناصر]

?

 

[الـعيدروس]

السلام عليكم

جرب الكود التالي

Dim Arr(), x_r
Public Sub Ali_Sm()
Dim Sh As Worksheet
Dim Sht As Worksheet
Dim My_rn As Range
Dim x, xx, Lr
Dim Tabl_My()
''----------------------
Set Sht = Sheets("Total")
''---------------------------------------------------------------------------
For Each Sh In Sheets
 If IsNumeric(Trim(Sh.Name)) Then
  With Sh
  ReDim Preserve Tabl_My(1 To 10000, 1 To 2)
   For R = 8 To .Cells(.Rows.Count, 1).End(xlUp).Row
    If .Cells(R, 1) <> Empty Then
     xx = .Cells(R, 1).Row
     x = x + 1
     Tabl_My(x, 1) = .Cells(xx, 1)
     Tabl_My(x, 2) = Application.Sum(.Range(.Cells(xx, 6), .Cells(xx, 36)))
    End If
   Next R
  End With
 End If
Next Sh
''---------------------------------------------------------------------------
x_r = 0
''--------------
Ali_Dicn Tabl_My
''--------------
If x_r Then
 With Sht
 ''=================================================================
     Lr = .UsedRange.Rows.Count
     Set My_rn = Range("B7:B" & IIf(Lr < 7, 7, Lr))
     My_rn.ClearContents
    .Range("B7").Resize(UBound(Arr, 1), UBound(Arr, 2)).Value = Arr
 ''=================================================================
 End With
    Erase Arr: x_r = 0
End If
Erase Tabl_My
Set Sht = Nothing: Set My_rn = Nothing
End Sub
Private Function Ali_Dicn(Ar As Variant)
Dim Idx As Object
Dim U_C, i, D
''--------------------------------------------------
U_C = UBound(Ar, 2): U_R = UBound(Ar, 1)
ReDim Arr(1 To U_R, 1 To U_C)
Set Idx = CreateObject("Scripting.Dictionary")
    With Idx
        For i = 1 To U_R
          If Not IsEmpty(Ar(i, 1)) Then
          If Not .exists(Ar(i, 1)) Then
                 x_r = x_r + 1
              For D = 1 To U_C
                 Arr(x_r, D) = Ar(i, D)
              Next D
                .Add Ar(i, 1), x_r
          ElseIf .exists(Ar(i, 1)) Then
                Arr(.Item(Ar(i, 1)), 2) = Arr(.Item(Ar(i, 1)), 2) + Ar(i, 2)
          End If
          End If
        Next i
    End With
''--------------------------------------------------
 Set Idx = Nothing
End Function

 

[محمد عبد الناصر]

والله يبقى كرم كبير منك لو تطبقهالى فى الملف المرفق لانى مش عارف اعملها من امبارح خالص

[الـعيدروس]

تفضل المرفق

انقر الزر المسمى اجماليات في ورقة Total

MD_111.rar

[محمد عبد الناصر]

قسما بالله انت ملكش حل ربنا يجعلو فى ميزان حسناتك متعرفش انت ساعدتنى اد ايه احسن حاجه انك عامل يجمع كلو ما عادا Sheet1

lمعلش انت عامل انو يجمع ايه بالظبط يعنى انهى سطر اقدر اغير فيه عشان لو عوزت اطبقها على كذا ملف عندى

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