تجميع شيتات

[sabah2022]

السلام عليكم

ممكن اضافة الجهة المستلمة الى كود الخبير محمد هشام

وكما مبين بالملف المرفق

جزيتم خيرا

تجميع V2 -2.xlsm

[محمد هشام.]

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

 

 

تجميع V2 -3.xlsm

تم تعديل سبتمبر 5, 2023 بواسطه محمد هشام.

[sabah2022]

السلام عليكم

تعلم استاذي اثناء العمل تظهر لنا امور 

ممكن الاطلاع على الملف 

يوجد شغله اخيرة

جزاك الله خير

تجميع V2 -3.xlsm

تم تعديل سبتمبر 5, 2023 بواسطه sabah2022

[احمد عبدالحليم]

بعد اذان الاستاذ الفاضل محمد هشام  

تعديل بدون اضافة عمود جديد للجهة المستلمة وانما لاخذ قيمتها من الخلية L2 من كل شيت 

والكود بصراحه قمة الروعة والفكر         تسلم ايدك وافكارك استاذنا

تجميع V2 -2.xlsm

[sabah2022]

جزيت خيرا

تمام  - بدون اضافة عمود 

وعند مشاركة (طلب) قبل هذه 

ممكن الاطلاع عليه

 

 

تم تعديل سبتمبر 5, 2023 بواسطه sabah2022

[محمد هشام.]

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

اما ادا كنت تقصد ان يتم جلب جميع البيانات مع تجاهل القيمة 0 فقط من كل عمود سوف ياثر دالك على صحة البيانات في عمود الجهة المستلمة

المرجوا التوضيح اكثر 

[sabah2022]

السلام عليكم

ارفقت ملف يشرح اللي احتاجه

جزيت خيرا 

وتسلم

تجميع -4.xlsm

[محمد هشام.]

تفضل جرب 

 

تجميع -5.xlsm

[sabah2022]

تسلم - جزيت خيرا - تمام

وفي حالة اضافة مع حقل ( l2)

d2

لاني حاولت اكثر مرة ولوقت كبير ولم احصل على النتيجة المطلوبة

 

 

تجميع شيتات 6.xlsm

تم تعديل سبتمبر 6, 2023 بواسطه sabah2022

[محمد هشام.]

تفضل 

For K = LBound(DestArr) To UBound(DestArr)
        Worksheets(DestArr(K)).Activate
        derligne = ActiveSheet.Range("a" & Rows.Count).End(xlUp).Row
        Rng = ActiveSheet.Range("A5:N" & derligne)
        sours = [L2]
        sours2 = [D2]
        For i = 1 To UBound(Rng, 1)
        If Rng(i, 1) > 0 And Rng(i, 2) > 0 And Rng(i, 1) <> "ت" Then
            y = y + 1: ReDim Preserve A(1 To UBound(Rng, 2) + 2, 1 To y)
            For F = 1 To UBound(Rng, 2)
                A(F, y) = Rng(i, F)
            Next
            With ws
            ws.[A2].Resize(y, UBound(A, 1)) = Application.Transpose(A)
            A(UBound(Rng, 2) + 1, y) = sours
            A(UBound(Rng, 2) + 2, y) = sours2
        End With
        End If
        Next
        
    Next

 

 

تجميع شيتات 7.xlsm

تم تعديل سبتمبر 6, 2023 بواسطه محمد هشام.

[sabah2022]

الله يرضى عليك

اشكرك

جزيت خيرا