عند ترحيل اسم من شيت1 الى شيت 2 يستبدل الاسم من شيت 2 ان كان موجود منعا للتكرار

[Mohmad83]

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

السادة الخبراء وفقكم الله

الملف يحتوي على ماكرو عند تحديد صف ومن ثم النقر على زر الماكرو يتم ترحيل الصف المحدد الى الشيت 2 

ما احتاجه عندما اريد ارحل صف الى شيت 2 وكان الاسم موجود اساسا في شيت 2 يتم استبداله منعا للتكرار .

ختاما اسئل الله ان يوفقكم ويحفظكم .

cbm.xlsm

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

جرب هذا الماكرو  (ينقل البيانات بدون تكرار) من اصفحة الاولى الى اثانية)

Option Explicit

Sub Get_data()
Dim S As Worksheet, T As Worksheet
Dim ro%, x%, Dic As Object
Dim st, ky, m%

Set S = Sheets("Source")
Set T = Sheets("Target")
Set Dic = CreateObject("Scripting.Dictionary")

If T.Range("B1").CurrentRegion.Rows.Count > 1 Then _
 T.Range("B1").CurrentRegion.Offset(1). _
 Resize(T.Range("B1"). _
 CurrentRegion.Rows.Count - 1).ClearContents
ro = S.Cells(Rows.Count, 2).End(3).Row
For x = 2 To ro
If S.Cells(x, 2) <> vbNullString Then
    st = Application.Transpose(S.Cells(x, 2).Resize(, 5))
    st = Application.Transpose(st)
    st = Join(st, "*")
    Dic(S.Cells(x, 2).Value) = st
End If
Next
 For Each ky In Dic.keys
    T.Cells(m + 2, 1) = m + 1
    T.Cells(m + 2, 2).Resize(, _
    UBound(Split(Dic(ky), "*")) + 1) = _
    Split(Dic(ky), "*")
  m = m + 1
 Next
 Set S = Nothing: Set T = Nothing
 Set Dic = Nothing
End Sub

الملف مرفق

mhmd83.xlsm

[Mohmad83]

 استاذ بس في مشكلة انو انا لا ارغب بنقل كل الاسماء الى شيت 2 والمشكلة في هذا الكود يقوم باضافة كل الاسماء بدون تكرار الى شيت 2 يعني انا وددت ان اختار اسم معين من شيت1  ليتم تحويله الى شيت2

ثانياً لوكان لدينا تاريخ بصيغة يوم/شهر/سنة سوف ينقل التاريخ  لشيت2  كا رقم ويفقد تنسيقه كتاريخ

تحياتي لك

[Mohmad83]

للرفع…   جزاكم الله عنا خيراً