Birleştirilmiş Hücrelerde Mükerrer Kayıt Hatası

[Seyit Tiken]

Herkese Selamlar,
Bir Çalışma sayfasında B, C ve D sütunları birleştirilmiş. Ve yukarıdan aşağıya doğru belirli aralıklarla sıralanmış. İlgili kodu bir türlü uyarlayamadım. Hata veriyor. Saygılarımı sunuyorum.

İlgili Kod :

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 1 Then
If WorksheetFunction.CountIf(Range("A1:A" & Target.Row - 1), Target) > 0 Then
MsgBox "BU İSİM KAYITLIDIR"
Target.Clear
Target.Select
End If
End If
End Sub

İlgili Dosya Aşağıda :

 

[veyselemre]

[vb:1:804a394839]Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Text <> "" And Not Intersect(Target, Range("B")) Is Nothing Then
If WorksheetFunction.CountIf(Range("B1:B" & Target.Row - 1), Target.Text) > 0 Then
MsgBox "BU İSİM KAYITLIDIR"
Range(Cells(Target.Row, "B"), Cells(Target.Row, "D")).ClearContents
End If
End If
End Sub[/vb:1:804a394839]