اضافة في كود الترحيل

[ضياء 2]

السلام عليكم استادتنا الكرام فضلا وجدت كود للاستاذ ابراهيم الحداد كنت عاوز جلب بيانات من عمود ثاني F بجوار E يرحل الى عمود I بجوار عمودH

Sub TrData()

Dim ws As Worksheet, Detl As Worksheet

Dim LR As Long, p As Long, i As Long, C As Range

Set ws = Sheets("قاعدة بيانات")

Set Detl = Sheets("بيان")

LR = Detl.Range("H" & Rows.Count).End(3).Row

For Each C In ws.Range("E2:E" & ws.Range("E" & Rows.Count).End(3).Row)

i = WorksheetFunction.CountIf(Detl.Range("H2:H" & LR), C)

If i = 0 Then

Detl.Range("H" & LR + 1).Offset(p).Resize(12) = C

p = p + 12

End If

Next

End Sub

[ضياء 2]

الملف استاذنا الكريم

wor1.xlsm

[حسين مامون]

ربما تقصد هذا 

Sub TrData()
Dim ws As Worksheet, Detl As Worksheet
Dim LR, LR1 As Long, p As Long, A As Long, C As Range
Set ws = Sheets("قاعدة البيانات")
Set Detl = Sheets("بيان")
LR = Detl.Range("H" & Rows.Count).End(3).Row
For Each C In ws.Range("E2:E" & ws.Range("E" & Rows.Count).End(3).Row)
A = WorksheetFunction.CountIf(Detl.Range("H2:H" & LR), C)
If A = 0 Then
Detl.Range("H" & LR + 1).Offset(p).Resize(12) = C
Detl.Range("I" & LR + 1).Offset(p).Resize(12) = C.Offset(, 1)
p = p + 12
End If
Next
End Sub

 

[محمد هشام.]

تفضل اخي الملف تم تعديل الكود مع امكانية اختيار عدد مرات التكرار  اضافة الى النتيجة بدون تكرار(يمكنك إخفائها من الأعمدة (Q:M) في حالة لم تكن لك رغبة بها)

  مع الاحتفاظ دائما  بشرط (عند وجود القيمة مسبقا في عمود تصنيف لا يتم الترحيل  من شيت البيانات إلى شيت بيان) كما في الصورة

TARHIL.M.H.xlsm

[ضياء 2]

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

كل الشكر والتقدير لاستاذ Mohamed Hicham فعلا استفدت من الكود شكرا جزيلا لكم

 

•