ترحيل بيانات من شيت لي شيت اخر

[موريادي]

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

عندي شيت DATA  وداخله بيانات عامل له ربط بي دالة Vlookup مع  شيت Vacation  Letter  عن طريق الكود لكل موظف فا احتاج عند اكتمال بيانات الشيت يتم ترحيله الى Vacation_Registor حسب الاعمدة المطلوبة وبعد ذالك في الشيت Vacation Report  احتاج يظهرلي الاجازة الخاصة لكل موظف من شيت Vacation_Registor بدون حذف الدالة vlookup من المربعات الحمراء في شيت Vacation Letter 

تـــم تعديل رفع الملف بـإمتداد XLSM طالما انك تريد الحل بأكواد VBA

تجربة 1.xlsm

[حسين مامون]

تجربة بالنسبة للترحيل من شيت Vacation Letter  الى Vacation_Registor

اتمنى ان يكون ما تريد

تجربة 1 (1).xlsm

[موريادي]

جزاك الله خير عمل جبار صراحه

فقط لو امكن اضافة كود مسح البيانات من شيت Vacation Letter بعد الترحيل واظهار رسالة بالترحيل ومسح البيانات بدون حذف دالة Vlookup

واضافة عدم تكرار البيانات في حال التكرار في شيت Vacation_Registor عند الترحيل

وشكراً لك

[حسين مامون]

جرب المرفق

تجربة 1 (1).xlsm

[موريادي]

ماشاء الله تبارك الله الملف ممتاز بس احتاج يكون التحقق من التكرار ليس بدلالة candidate key لأنه متكرر حسب الموظف ولكن اريد التأكد من عدم التكرار لاسم الموظف وتاريخ بداية ونهاية الاجازة ونوع الاجازة لعدم تكرارها من قبل المدخل ان امكن ؟ وشكراً لك على المساعدة العظيمة استاذ حسين

[حسين مامون]

اخي الكريم 

يمكن لاسم واحد ان يتكرر ايضا  في اجازتين  والتاريخ كذلك يمكن ان يتكرر  فلا ار ى هذا حلا لموضوعك 

ما رايك في اضافة عمود يسمى "رقم الاجازة"

وكل اججازة تحمل رقم ويتغير  في الطلب بعد كل ترحيل

انظر المرفق

تجربة 1 (1).xlsm

[موريادي]

الله يعطيك العافية التحقق من التكرار كان مفيد جدا بس احتاج الان من شيت Vacation Report انه يكون فلتره عن كل اجازات الموظف مثلا الموظف رقم 1 اخذ خمسة اجازات خلال الخمس سنين فا احتاج تكون هناك عملية فلترة عن جميع اجازات موظف رقم 1  او حسب نوع الاجازة … ولك جزيل الشكر والتقدير 

[حسين مامون]

ادخل بعض البيانات في الشيت كما تتصورها ثم ارفعه 

والله المستعان

[موريادي]

مرفق لك الشيت مع البيانات للتوضيح وشكراً على تعبك وتحملك لطلباتي استاذ حسين

تجربة 1 (1).xlsm

[حسين مامون]

جرب المرفق

Private Sub Worksheet_Change(ByVal Target As Range)
Dim WS1 As Worksheet: Set WS1 = Sheets("Vacation_Registor")
            WS1.ListObjects("الجدول520").Range.AutoFilter Field:=1
            WS1.ListObjects("الجدول520").Range.AutoFilter Field:=5

Dim RG1, RG, RG2
Dim lr1, lr
Dim x
Application.ScreenUpdating = False
If [c2] = "" Then MsgBox "المرجو اختيار الاسم اولا": Exit Sub
If Not Intersect(Target, Range("c3")) Is Nothing Then
            '====================
            Set RG1 = ListObjects("الجدول119").Range
            lr1 = RG1.Find(WHAT:="*", AFTER:=RG1.Cells(1), lookat:=xlPart, LookIn:=xlFormulas, searchorder:=xlByRows, _
            searchdirection:=xlPrevious, MatchCase:=False).Row + 1
            Range("b5:e64").ClearContents
            '====================
            WS1.Range("a2:g2").AutoFilter
            WS1.ListObjects("الجدول520").Range.AutoFilter Field:=1, Criteria1:=Range("c2")
            WS1.ListObjects("الجدول520").Range.AutoFilter Field:=5, Criteria1:=Target
            '====================
            Set RG = WS1.ListObjects("الجدول520").Range
            lr = RG.Find(WHAT:="*", AFTER:=RG.Cells(1), lookat:=xlPart, LookIn:=xlFormulas, searchorder:=xlByRows, _
            searchdirection:=xlPrevious, MatchCase:=False).Row
            If lr = 2 Then Exit Sub
            WS1.Range("b3:e" & lr).Copy
            Range("b5").PasteSpecial
            '     Range("a5:a" & lr + 1).Formula = "=IF(B5="""","""",SUBTOTAL(103,$B$5:B5))"
            WS1.ListObjects("الجدول520").Range.AutoFilter Field:=1
            WS1.ListObjects("الجدول520").Range.AutoFilter Field:=5
End If
Application.ScreenUpdating = True
End Sub

الملف

 

تجربة 1 (1) (1).xlsm