طلب المساعدة في كود ترحيل بدون تكرار

[gamalin]

اسلام عليكم ورحمة الله وبركاته ..الاخوة الافاضل في الملف المرفق كود للترحيل وفقا للصفحة يعمل جيدا 

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

عدم التكرار.xlsm

[حسين مامون]

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

اليك هذا الكود جربه 

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

تانيا : يفحص كود العميل في العمود b في الداتا و العمود b في شهر (الصفحة المطابقة للشرط الاول) اذا وجد الكود يمر الى التالي وغير ذلك يرحل

ملاحظة : اضف تتمة الكود حسب ما تريد ان يرحل

تحياتييييييييييييييييييييييييييي

Option Explicit

Sub tarhil2()
Dim sh As Worksheet
Dim ws As Worksheet
Set ws = Sheets("Accmove")
Dim lr1, lr2, x
Application.ScreenUpdating = False
lr1 = ws.Cells(Rows.Count, 3).End(3).Row
For Each sh In Sheets
If sh.Name <> "Accmove" Then
For x = 4 To lr1
lr2 = sh.Cells(Rows.Count, 2).End(3).Row
If lr2 = 3 Then lr2 = lr2 + 1

If sh.Name = ws.Cells(x, 17).Text Then
            If Application.WorksheetFunction.CountIf(sh.Range("b5:b" & lr2), ws.Cells(x, 2)) > 0 Then GoTo 1
'===============
            sh.Range("b" & lr2 + 1).Value = ws.Cells(x, 2)
            sh.Range("c" & lr2 + 1).Value = ws.Cells(x, 3)
'اضف ما تريد ان يرحل هنا كالسطرين اعلاه

'===============
            End If
1: Next x
End If
Next sh
Application.ScreenUpdating = True

End Sub

 

[gamalin]

اشكرك اخي الكريم باافعل هو المطلوب تماما اشكرك وفار التحية والاحترام