Mükerrer kayıt varsa UserForm1 açılsın.

[kelkitli]

Değerli Dostlar Selamlar,

Sub kayıt()
On Error Resume Next
Application.ScreenUpdating = False
Set S1 = Sayfa1
Set S2 = Sayfa2
S1.Select
Range("C1:C26").Copy
S2.Select
Son_Satır = Range("B65536").End(3).Offset(1).Row
Range("A" & Son_Satır) = Son_Satır - 1
Range("B65536").End(3).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=True, Transpose:=True
Application.CutCopyMode = False
S1.Select
Set S1 = Nothing
Set S2 = Nothing
MsgBox "YAŞLI KAYDI TAMAMLANDI"
End Sub

Kodlarıyla kayıt yapıyorum. Sayfa2 A ve AA sütunlarının ikisi mükerrerse Userform1 açılsın ve bilgileri çağırıp düzeltip kaydedeyim. Ama ne kadarı yapılabilirse o kadarı olsun. Katkılarınız olursa memnun olurum.

 

[Levent Menteşoğlu]

Mükerre kayıt kriterlerinizi biraz daha açarmısınız. A ve AA sütunu bana kontrol için yanlış yazılmış gibi geldi.

 

[kelkitli]

Sayın Levent Hocam,
Öncelikle ilginizden dolayı teşekkür ederim. Yanlışlıktan dolayı özür dilerim. Olay şu: Eklediğim dosta Sayfa1 C sütunundaki bilgileri "Bilgileri kaydet" butonuyla Sayfa2 ye kaydediyorum. Bu kaydettiğim bilgi Sayfa2 B sütununda TC Kimlik No mükerrerse ve AA sütununda "Yeni" ibaresi varsa UserForm1 açılsın. (UserForm1 şu an Mükerrerkayıtla açılmadığından CommandButton7 ile açılıyor) UserForm_Activate olayına eklediğim makro ile Mükerrer kayıt bilgilerini UserForm1 e alsın. Üzerinde düzeltme yaptıktan sonra (kayıp,yıpranma) aynı TC kimlikle eski kaydı yeiliyeym ve "Düzelt" butonuna tıklayınca düzelt isimli makroyu çalıştırıp Userform1 kapansın. (Kendimce çağırmak için ve düzeltmek için gerekli makroları hazırladım.)

 

[Korhan Ayhan]

Selamlar,

Kayıt isimli makronuzu aşağıdaki gibi değiştirip denermisiniz.

Not: YENİ kelimesinin başına boşluk eklemişsiniz. Bunları düzeltmeniz gerekiyor.

Sub Kayıt()
    On Error Resume Next
    Application.ScreenUpdating = False
    Set S1 = Sayfa1
    Set S2 = Sayfa2
    S1.Select
    Set Bul = S2.[B:B].Find([C1])
    If Not Bul Is Nothing Then
    If S2.Cells(Bul.Row, "AA") = "YENİ" Then
    MsgBox "MÜKERRER KAYIT !", vbCritical, "DİKKAT !"
    UserForm1.Show
    Exit Sub
    End If
    End If
    Range("C1:C26").Copy
    S2.Select
    Son_Satır = Range("B65536").End(3).Offset(1).Row
    Range("A" & Son_Satır) = Son_Satır - 1
    Range("B65536").End(3).Offset(1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=True, Transpose:=True
    Application.CutCopyMode = False
    S1.Select
    Set S1 = Nothing
    Set S2 = Nothing
    MsgBox "YAŞLI KAYDI TAMAMLANDI"
End Sub

 

[kelkitli]

Selamlar Sayın Korhan Bey,
Teşekkürlerimi iletiyorum. İşlem tamam.