نسخ خلايا محدده من عدة شيتات الى شيت المجموع

[ابو مخيزيم]

طلبي يا أساتذتي وأخوتي الكرام

هو نسخ أو ترحيل بيانات الخلايا الملونة باللون الاخضر في الشيتات من 1-3

بخيث يتم تجميعها تلقائيا في نفس الخلايا في شيت تجميع

حاولت كثيرا الاستفادة من المواضيع المطروحة لكنني لم أصل لنتيجة.

ومرفق الملف 

مع جزيل الشكر

حركة المرضى.xlsm

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

جرب هذا الملف (تم ازالة زركشات الألوان لتصغير ججم الملف)  بالاضافة الى تجسين المعادلات بجيث لا تظهر اخطاء

الكود

Option Explicit

Sub Get_sum()
Const Start = 7
Const Fin = 37
Dim ar_sh, Ar_sum(15)
Dim A1, A2, A3
Dim ro_ws%, i%, k%

ar_sh = Array("ICU1", "ICU2", "ICU3")
  For i = Start To Fin
      A1 = Sheets(ar_sh(0)).Range("B" & i).Resize(, 16)
        A1 = Application.Transpose(A1)
        A1 = Application.Transpose(A1)
      
      A2 = Sheets(ar_sh(1)).Range("B" & i).Resize(, 16)
        A2 = Application.Transpose(A2)
        A2 = Application.Transpose(A2)
      
      A3 = Sheets(ar_sh(2)).Range("B" & i).Resize(, 16)
        A3 = Application.Transpose(A3)
        A3 = Application.Transpose(A3)
     For k = 0 To 15
      Ar_sum(k) = Val(A1(k + 1)) + Val(A2(k + 1)) + Val(A3(k + 1))
     Next k
    Sheets("totalICU").Range("B" & i).Resize(, 16) = _
     Ar_sum
  Next i
End Sub

Malades.xlsm

[خيماوي كووول]

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

طريقة اخرى .. عن طريق data .. نقوم بختيار consolidate .. عملية الجمع sum ..

Copy of حركة المرضى.xlsm

[ابو مخيزيم]

أشكرك أستاذي الكريم سليم حاصبيا

هذا هو المطلوب

زادك الله رفعة في الدنيا والآخرة

أستاذي الكريم خيماوي كووول

زادك الله رفعة في الدنيا والآخرة

وأشكرك على الاهتمام بموضوعي

هذه الطريقة سبق وأن جربتها لكن لم تقلح معي

أو أنني لم أفهمها جيدا

تم تعديل ديسمبر 7, 2020 بواسطه ابو مخيزيم

[ابو مخيزيم]

أستاذي الكريم سليم

كيف يمكن التعديل لإضافة العمودين Tو U

حيث لم تنتقل البيانات اليها

وأرجوا أت تقبل آسفي وإعتذاري على إزعاجك

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

استبدل في الكود الرقم 15 بـــ  19

والرقم 16 بـــــ  20

اي زيادة 4 أعمدة

 

[خيماوي كووول]

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

تفضل اخوي العزيز .. بعد اذن اخوي العزيز .. سليم

Copy of Malades.xlsm

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

كما يمكنك استعمال هذا الماكرو  البسيط

Option Explicit

Sub Get_sum_by_formula()
  With Sheets("totalICU").Range("B7").Resize(31, 20)
    .ClearContents
    .Formula = "=SUM('ICU1:ICU3'!B7)"
    .Value = .Value
  End With
End Sub

 

[ابو مخيزيم]

كذا تمام

أسعدتموني أسعدكم الله في الدنيا والآخرة

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