مقارنة اعمدة لغرض التدقيق

[nash60]

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

فضلا لو تكرمتم المساعدة في المقارنة لغرض التدقيق عمودين  في ورقتين  والشرح موضح في المثال المرفق 

شاكر فضل الجميع وجزاكم الله خيرا

المصنف2.rar

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

جرب هذا الكود

Option Explicit
Sub compaire_columns()
Dim sh1 As Worksheet, sh2 As Worksheet
Dim First_rg1 As Range, Sec_rg1 As Range
Dim First_rg2 As Range, Sec_rg2 As Range

Dim m%, i%

Set sh1 = Sheets("بيانات 1"): Set sh2 = Sheets("بيانات2")
sh1.Range("A2").CurrentRegion.Columns(3).Offset(1).Resize(100, 2).Clear
Set First_rg2 = sh2.Range("a2").CurrentRegion.Columns(1)
Set Sec_rg2 = sh2.Range("a2").CurrentRegion.Columns(2)

Set First_rg1 = sh1.Range("a2").CurrentRegion.Columns(1)
Set Sec_rg1 = sh1.Range("a2").CurrentRegion.Columns(2)
For i = 2 To First_rg1.Rows.Count
 If First_rg1.Cells(i) = First_rg2.Cells(i) Then
   First_rg1.Cells(i).Offset(, 2) = "مطابق"
 Else
 First_rg1.Cells(i).Offset(, 2).Interior.ColorIndex = 6
 End If
 Next
 For i = 2 To Sec_rg1.Rows.Count
 If Sec_rg1.Cells(i) = Sec_rg2.Cells(i) Then
  Sec_rg1.Cells(i).Offset(, 2) = "مطابق"
 Else
 Sec_rg1.Cells(i).Offset(, 2).Interior.ColorIndex = 6
  End If
  Next
End Sub

الملف مرفق

 

المصنف2 _سليم.rar

[nash60]

الاخ الفاضل سليم 

اشكرك جزيل الشكر على سرعة الرد وعلى هذا الحل الرائع وجعله الله في ميزان حسناتك