Mükerrer kayıt engelleme

[manisali50]

Arkadaşlar merhaba..
Mükerrer kayıt engelleme ile ilgili dosyam ektedir.
Şimdiden teşekkürler

 

[ReBiwAr]

Ektedir.

iyi Çalışmalar.

 

[manisali50]

Üstadım merhaba.
Öncelikle ilgine teşekkür ediyorum ama maalesef değişen hiçbirşey yok.
Yine "Bu kod daha önceden verilmiştir" uyarısı çıkıyor.Ama STOK sayfasına baktığımızda aynı kod numarası ile girdiğimiz diğer ürünü de kaydediyor.

 

[Mahir64]

Merhaba
Kodu bununla değiştirin

Sub yeni_malzeme()
ss = Sheets("STOK").[A5000].End(3).Row + 1
With Sheets("STOK")
'Mükerrer sorsula
Sat = Sheets("STOK").[b65536].End(3).Row + 1
Say = WorksheetFunction.CountIf(Sheets("STOK").Range("b:b"), Sheets("ANA EKRAN").Range("c18"))
If Say > 0 Then
MsgBox "Bu kayıt daha önce girilmiştir !" & vbNewLine & _
"Lütfen girdiğiniz bilgileri kontrol ediniz.", vbCritical, "Mükerrer Kayıt"
Exit Sub
    End If
    .Cells(ss, 1).Value = ss - 3
    .Cells(ss, 2).Value = Sheets("ANA EKRAN").Cells(18, 3).Value
    .Cells(ss, 3).Value = Sheets("ANA EKRAN").Cells(17, 3).Value
    .Cells(ss, 5).Value = Sheets("ANA EKRAN").Cells(18, 5).Value
    .Cells(ss, 4).Value = Sheets("ANA EKRAN").Cells(20, 3).Value
    .Cells(ss, 10).Value = Sheets("ANA EKRAN").Cells(19, 3).Value
MsgBox "MALZEME EKLENDİ ", vbInformation, "Şerif Ali ŞENSAZLI"
End With
End Sub

 

[manisali50]

Teşekkür ederim arkadaşım..Tam istediğim gibi oldu..

 

[Mahir64]

Teşekkür ederim arkadaşım..Tam istediğim gibi oldu..

Kolay gelsin