aynı isim ve soyisimle fakat diğer bilgileri farklı olan yeni bir kayır

[acemi23]

merhaba arkadaşlar
Private Sub cmdkaydet_Click()
Dim bak As Range
Dim say As Integer
For Each bak In Range("A1:A" & WorksheetFunction.CountA(Range("A1:A65000")))
If bak.Value = cbAd.Value Then
MsgBox "Bu Kayıt numarası bulundu."
Exit Sub
End If
Next bak
For Each bak In Range("B1:B" & WorksheetFunction.CountA(Range("B1:B65000")))
If StrConv(bak.Value, vbUpperCase) = StrConv(cbAd.Value, vbUpperCase) Then
MsgBox "Bu isimde bir kaydınız bulundu"
Exit Sub
End If
Next bak

say = WorksheetFunction.CountA(Range("B1:B65000"))
txtsira.Value = say

Cells(say + 1, 1).Value = txtsira.Value
Cells(say + 1, 2).Value = cbAd.Value
Cells(say + 1, 3).Value = txtSoyadı.Value
Cells(say + 1, 4).Value = txtAnaAdı.Value
Cells(say + 1, 5).Value = txtbabaadı.Value
Cells(say + 1, 6).Value = txtDoğumTarihi.Value
Cells(say + 1, 7).Value = txtTcKimlikNo.Value
Cells(say + 1, 8).Value = txtSiteAdı.Value
Cells(say + 1, 9).Value = txtCaddeSokak.Value
Cells(say + 1, 10).Value = txtkapıNo.Value
Cells(say + 1, 11).Value = TxtDaireNo.Value
Cells(say + 1, 12).Value = txtEğitimDurumu.Value
Cells(say + 1, 13).Value = txtSosyalGüvence.Value
Cells(say + 1, 14).Value = txtYakacak.Value
Cells(say + 1, 15).Value = txtTelno.Value
Cells(say + 1, 16).Value = txtMahalle.Value

ThisWorkbook.Save
MsgBox "Verileriniz Kaydedildi", , "KAYIT"
cmdtemizle_Click
cbAd.RowSource = "Veri!B2:B" & say + 1
txtsira.Value = WorksheetFunction.Count(Range("A1:A65000")) + 1

kodlama bu kaydı yapamıyorum akydet dediğimde "A1:A65000" üstü mavi yanıyo