مطلوب كود ترحيل بيانات من شيت الى شيت اخر بشرط

[المحاسب المبتديء]

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

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

المصنف1.xlsx

[الـعيدروس]

السلام عليكم

حسب ملفك اظن يحتاج تحدد

اوقات الحضور

اوقات الانصراف

مثال

اوقات الحضور 07:00 ص حتى 13:00 م

اوقات الانصراف 14:00 م حتى 21:00 م

او اذا النظام فترات تحدد مجموعة فترات بحيث يعتمد الترحيل بموجبها

مجموعة 1

اوقات الحضور 07:00 ص حتى 10:00 ص

اوقات الانصراف 10:01 ص حتى 14:00 م

مجموعة 2

اوقات الحضور 14:01 م حتى 16:00 م

اوقات الانصراف 16:01 م حتى 21:00 م

[المحاسب المبتديء]

السلام عليكم استاذي العيدروس مشكور جدا على اهتمامك 

الحضور والانصراف لا يعتمد على مجموعات 

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

ويتم الترحيل كل تاريخ في تاريخه المقابل له اي مثلا حضر الموظف رقم 1002 في يوم 1/09/2019  الساعه 8:49 يتم نقلها الى الصفحه الخاصه به aaaa في تاريخها 

[الـعيدروس]

 

السلام عليكم

جرب الكود التالي بدائي اذا عدد الصفحات قليلة

الكود Ref_Cel لاصلاح الخلايا التي التواريخ فيها لاتقراء

بالامكان استخدامه منفصل 

 

Private Const تايم_شت = "تايم شيت " ' مسمى صفحة تقرير حركة البصمة
Private Const الرقم_الوظيفي = "$B$2" ' مرجع خلية رقم الوظف بالصفحات
Private Const سجل_الايام = "$B$6:$B$35" ' مدى التواريخ بصفحة الموظف
Dim Tim_Sht         As Worksheet
Private Sub Ref_Cel()
Dim Rng As Range
Dim i
With Tim_Sht
    Lr = .Cells(.Rows.Count, "A").End(xlUp).Row
    Set Rng = Range("B2:B" & Lr)
            Rng.Select
            Rng.NumberFormat = "dd/mm/yyyy"
            Rng.Select
    For i = 1 To Rng.Rows.Count
        SendKeys "{F2}", True
        SendKeys "{ENTER}", True
    Next i
End With
End Sub
Sub Alidroos()
Dim Lr              As Long
Dim Rng_Sht         As Range
Dim My_Rng          As Range
Dim Sht_All         As Worksheet
Dim Num_JOP
Dim Rng_Date        As Range
Dim Date_JoP        As Date
Dim Tim_C           As Date
Dim Tim_D           As Date
Dim Row_Date
Dim Tl_Row          As Long
Dim Nm_Sh           As String
'--------------------------------------------------------------------------------------------
'>>>>>>>>>>>>>>>>
 Apple_Speed False
'>>>>>>>>>>>>>>>>
'--------------------------------------------------------------------------------------------
Set Tim_Sht = Sheets(تايم_شت)   ' ورقة تقرير حركة ماكنة البصمة
'--------------------------------------------------------------------------------------------
Lr = Tim_Sht.Cells(Tim_Sht.Rows.Count, "A").End(xlUp).Row ' اخر صف به بيانات
'--------------------------------------------------------------------------------------------
Ref_Cel ' لخلل بعض الاسطر التاريخ غير صحيح
' يوقف بعد اول تنفيذ
'--------------------------------------------------------------------------------------------
Set Rng_Sht = Tim_Sht.Range("A2:A" & Lr) ' مدى بيانات تقرير حركة ماكنة البصمة
'--------------------------------------------------------------------------------------------
For Each My_Rng In Rng_Sht ' حلقة تكرارية لمدى تقرير البصمة
'--------------------------------------------------------------------------------------------
    For Each Sht_All In Sheets  ' حلقة تكرارية لصفحات الملف
'--------------------------------------------------------------------------------------------
    If Not Sht_All.Name = تايم_شت Then ' شرط تجاوز صفحة تقرير ماكنة البصمة
'--------------------------------------------------------------------------------------------
        Num_JOP = Sht_All.[B2] ' الرقم الوظيفي من صفحة الموظف الخاصة
'--------------------------------------------------------------------------------------------
       If My_Rng = Num_JOP Then ' اذا الرقم الوظيفي يطابق الذي فالصفحات
'--------------------------------------------------------------------------------------------
'          Tl_Row = My_Rng.Row ' رقم سطر بيانات الحركة للبصمة
'--------------------------------------------------------------------------------------------
          Nm_Sh = Sht_All.Name ' اسم الصفحة الخاصة بالموظف
'--------------------------------------------------------------------------------------------
          Date_JoP = Format(My_Rng.Offset(0, 1), "dd/mm/yyyy") '' تاريخ الماكنة
'--------------------------------------------------------------------------------------------
          My_Rng.Offset(0, 1).Interior.Color = RGB(238, 219, 243) '' لون السطر المرحل
'--------------------------------------------------------------------------------------------
          Tim_C = My_Rng.Offset(0, 2)   'C' وقت حضور'
'--------------------------------------------------------------------------------------------
          Tim_D = My_Rng.Offset(0, 3) 'D' وقت انصراف'
'--------------------------------------------------------------------------------------------
            For Each Rng_Date In Sheets(Nm_Sh).Range(سجل_الايام) ' حلقة تكرارية لعمود التواريخ بصفحات الموظفين
'--------------------------------------------------------------------------------------------
                If Rng_Date = Date_JoP Then ' شرط تطابق تاريخ التقرير والصفحات
'--------------------------------------------------------------------------------------------
                    Row_Date = Rng_Date.Row ' سطر التاريخ في سجل الموظف
'--------------------------------------------------------------------------------------------
                            Sht_All.Cells(Row_Date, "D") = Tim_C  ' C' ترحيل عمود
'--------------------------------------------------------------------------------------------
                            Sht_All.Cells(Row_Date, 4).Interior.Color = RGB(238, 219, 243) ' لون المرحل
'--------------------------------------------------------------------------------------------
                            Sht_All.Cells(Row_Date, "E") = Tim_D  ' D' ترحيل عمود
'--------------------------------------------------------------------------------------------
                            Sht_All.Cells(Row_Date, 5).Interior.Color = RGB(238, 219, 243) ' لون المرحل
'--------------------------------------------------------------------------------------------
                End If
'--------------------------------------------------------------------------------------------
            Next Rng_Date
'--------------------------------------------------------------------------------------------
       End If
'--------------------------------------------------------------------------------------------
    End If
'--------------------------------------------------------------------------------------------
    Next Sht_All
'--------------------------------------------------------------------------------------------
Next My_Rng
'--------------------------------------------------------------------------------------------
'<<<<<<<<<<<<<<<<<
 Apple_Speed True
'<<<<<<<<<<<<<<<<<
End Sub
Private Sub Apple_Speed(Bl As Boolean)
With Application
    .Calculation = IIf(Bl, -4105, -4135)
    .ScreenUpdating = Bl
    .EnableEvents = Bl
End With
End Sub

 

[المحاسب المبتديء]

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

اخي العزيز العيدروس  بعد التحية 

ليس لدي خبره كبيره في مجال برمجة الفيجول بيزك ياريت تتكرم وتفعل الكود على الشيت المرفق لاتمكن من اتمام شيتات المنظومه ولك مني فائق الشكر والتقدير 

مع سالف الشكر والتقدير 

تم تعديل سبتمبر 22, 2019 بواسطه المحاسب المبتديء

[الـعيدروس]

تفضل انقر على الزر تجدة في ورقة تايم شت

المصنف111.xls

[المحاسب المبتديء]

الشكر الموصول لك  اخي العزيز العيدروس  اللهم زدك علما وبارك لك في عملك ورزقك على مابذلته في مساعدتي