Tüm çalışma kitabında mükerrer kayıt engellemesi

[hasaona]

Merhaba;

Hergün yeni tarihli çalışma sayfası oluşturduğum için mükerrer kayıtın önüne geçemiyorum. Bilen arkadaşlar örnek olarak"şu isimdeki çalışma sayfasının h5 satırında aynı veri vardır" uyarı şeklinde mükkerer veriyi önleyecek şekilde yardımcı ola bilecek arkadaşlardan rica ediyorum

 

[tahsinanarat]

'Kodu "ThisWorkbook" ya da "BuÇalışmaKitabı" bölümüne uygulayınız.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim Sayfa As Worksheet, Bul As Range
If Intersect(Target, Range("A2:Z" & Rows.Count)) Is Nothing Then Exit Sub
If Target = "" Then Exit Sub
Application.EnableEvents = False
For Each Sayfa In ThisWorkbook.Worksheets
If Sayfa.Name <> Sh.Name Then
Set Bul = Sayfa.Range("A:Z").Find(Target, , , xlWhole)
If Not Bul Is Nothing Then
MsgBox "Mükerrer kayıt tespit edilmiştir." & Chr(10) & Chr(10) & _
"Bulunan sayfa adı ; " & Sayfa.Name & Chr(10) & _
"Bulunan hücre adresi ; " & Bul.Address(0, 0), vbCritical
Target.Select
Target = ""
GoTo Son
Exit Sub
End If
Else
If WorksheetFunction.CountIf(Range("A:Z"), Target) > 1 Then
Set Bul = Sayfa.Range("A2:Z" & Target.Row - 1).Find(Target, , , xlWhole)
If Not Bul Is Nothing Then
MsgBox "Mükerrer kayıt tespit edilmiştir." & Chr(10) & Chr(10) & _
"Bulunan sayfa adı ; " & Sayfa.Name & Chr(10) & _
"Bulunan hücre adresi ; " & Bul.Address(0, 0), vbCritical
Target.Select
Target = ""
GoTo Son
Exit Sub
End If
End If
End If
Next
Son: Application.EnableEvents = True
End Sub