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

[نسورالجو]

السلام عليكم ... لابد من التحية عند بدء أى مشاركة ,,, مطلوب ترحيل البيان الموجودة في العمود تصنيف الي شيت بيان مع تكرار  البيان الموجود في عمود تصنيف12 مره مع عدم ترحيل البيان لو وجد في عمود تصنيف في شيت بيان

wor1.xlsm

[ابراهيم الحداد]

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

استخدم الكود التالى

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

 

[نسورالجو]

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

[نسورالجو]

السلام عليكم الاخوة الافاضل بالمنتدى ..المطلوب مساعدة في تعديل كود الترحيل والشرح داخل الشيت

wor1.xlsm