تلوين خلية بجميع اوراق العمل اذا تكررت في اي ورقة عمل

[مازن امام]

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

ارجو المساعدة 

المطلوب تلوين الخلايا المكرره في أي شيت

 A مثال لو اردت كتابة 120  في خلية في شيت جديد بالعمود

 فانه يلون الخلية التي قيمتها 120 في جميع أوراق العمل

كما هو موضح بالملف المرفق

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

ارجو المساعدة وانا شاكر لكل من حاول المساعدة

معرفة التكرار في عدة شيتات.xlsx

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

Try This macro

Option Explicit
Sub Colorize()
Dim Sh As Worksheet
Set Sh = ActiveSheet
Dim Rg As Range, cel As Range
Dim at_c As Worksheet
Dim Fadr$, Sadr$, i%
Dim Act_Rg As Range, F_rg As Range
Set Rg = Sh.Range("a1").CurrentRegion.Columns(1).Cells
Rg.Interior.ColorIndex = xlNone
For i = 1 To Sheets.Count
      If Sheets(i).Name <> Sh.Name Then
          Set Act_Rg = Sheets(i).Range("a1").CurrentRegion.Columns(1)
          Act_Rg.Interior.ColorIndex = xlNone
          For Each cel In Rg
              Set F_rg = Act_Rg.Find(cel, lookat:=1)
              If F_rg Is Nothing Then GoTo Next_cel
              cel.Interior.ColorIndex = 6
              Fadr = F_rg.Address: Sadr = Fadr
                Do
                  F_rg.Interior.ColorIndex = 6
                  Set F_rg = Act_Rg.FindNext(F_rg)
                  Sadr = F_rg.Address
                  If Sadr = Fadr Then Exit Do
                Loop
Next_cel:
          Next cel
    End If

Next i
End Sub

File Included

 

Tekrar_by_sheets.xlsm

[مازن امام]

الف شكر اخي على سرعة الاستجابه 

الكود رائع ولكن اريده ان يعمل تلقائي اي بمجرد اضافة اي قيمة باي ورقة عمل اذا كانت هذه القيمة موجودة باي ورقة عمل يتم تلوينها تلقائي

ارجو ان يكون الطلب واضح

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

يمكن اضافة هذا الكود الى حدث  Workbook ليعمل كما تريد

Option Explicit

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Application.EnableEvents = False
If Not Intersect(Target, Sh.Range("A1").CurrentRegion.Columns(1)) Is Nothing And _
  Target.Count = 1 Then
 Colorize
 End If
 Application.EnableEvents = True
End Sub

الملف مرفق

Auto_Tekrar_by_sheets.xlsm

[مازن امام]

الف شكر استاذ سليم 100/100

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

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

 

Tekrar_by_sheets_Address.xlsm

[مازن امام]

اشكرك استاذ سليم انت انسان مبدع 

ممكن سؤال  اذا بدي اغير اعمدة (اسم الصفحة ورقم السطر) اي كود لازم اغير ؟

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

في كل الاكواد داخل الملف استبدل حرف  A الى اسم العامود الذي تريده