مساعدة في ترحيل بيانات

[MamdouhElawa]

لو سمحتم اريد مساعدتكم في ترحيل بياانات من ملف حضور وانصراف الي كشف رواتب علما باني قد بحثت كثيرا ولم استطيع عمل الكود ومرفق ملف توضيحي لما اريد

مشكورين مقدما

كشف رواتب.rar

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

جرب هذا الماكرو

Option Explicit

Sub transfer_data()
Dim main_Sh As Worksheet
Dim m As Integer
 Set main_Sh = Sheets("Sheet1")
 
        With main_Sh
            .Select
            .Range("a2:H" & Sheets.Count).ClearContents
        End With
        
  For m = 2 To Sheets.Count
        With main_Sh
             Sheets("sheet" & m).Range("f39:f44").Copy
            .Range("A" & m).PasteSpecial Paste:=xlValues, Transpose:=True
            .Range("g" & m) = Evaluate("=SUM(B" & m & ",F" & m & ")-SUM(C" & m & ":E" & m & ")")
        End With
Next
main_Sh.Range("a1").Select
End Sub

مرفق مثال

 

كشف رواتب salim.rar

[MamdouhElawa]

استاذي الفاضل سليم مشكور جدا علي المجهود الرائع بس عندي مشكلة لما جيت اطبق الماكرو علي الملف الاصلي للرواتب لان الشيت مكتوب باسماء العاملين فهل من مساعدة فكيفية تغير الكود ليعمل بشكل صحيح

شكرا مرة ثانيه

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

تم التعديل على الماكرو ليتناسب مع الوضع(يجب تسمية الورقة بالضيط كما هو اسم صاحبها (يعني تاخذ الاسم Copy , وتسمي الورقة Paste)

 

 

كشف رواتب salim1.rar

[MamdouhElawa]

والله يا استاذي عاجز عن الشكر دائما حضرتك تفيد الجميع ربنا يجعله في ميزان حسناتك