Veri aktarma-Mükerre kayıt uyarısı ve Sorgulama

Katılım
13 Kasım 2008
Mesajlar
81
Excel Vers. ve Dili
EXCEL2003
Değerli Arkadaşlar sizlerden ricam Excel sayfa 1 de birleştirilmiş hücrelerim var bu hücrelere veri girdiğimde diğer ikinci sayfaya alt alta aşağıdaki vermiş olduğum kodlar ile bu verileri satırlara yazdırabiliyorum .Mükerrer kayıtları engellemek istiyorum.Aynı kaydı ikinci defa girilmesini engellemek istiyorum.
1-Aşağıdaki kodlar doğrumu?Doğru ise bu kodların içine mükerrer kaydı önleyecek kodu yazarmısınız.
Sub Ekle()
Application.ScreenUpdating = False
ActiveWindow.SmallScroll
Range("D99:121").Select
Selection.Copy
sat = Sheets("Veri").Cells(65536, 1).End(xlUp).Row
Sheets("Veri").Select
Range("a1").Select
Sheets("Veri").Cells(sat + 1, 1).PasteSpecial , , , True
Selection.PasteSpecial , Paste:=xlValues, operation:=xlNone, Transpose:=True
Application.CutCopyMode = False
Sheets(1).Select
ActiveWorkbook.Save
MsgBox "ŞAHSIN KİMLİK BİLGİLERİ KAYDEDİLDİ"
End Sub
Ancak kaydettiğim verileri zaman zaman tekrar birinci sayfaya birleştirilmiş hücrelere geri getirmem gerekiyor yani ikinci sayfadan sorgulatıp girilen verilerin birinci sayfaya gelmesini istiyorum.Girdiğim bu verilerden istediğim yok ise istenilenin olmadığını mesaj olarak belirtmesini istiyorum.Bunun için birinci sayfaya sorgulama butonu koydum kişiyi veri sayfasında buluyor ancak birleştirilmiş hücre olduğu için getirip yapıştıramıyor ve hatalar veriyor.
Bunun için aşağıdaki kodları kullanıyorum
Sub arabul()
ara = Application.InputBox(prompt:="!ARANACAK KİŞİNİN TC KİMLİK NOSUNU YAZINIZ", Type:=3)
Sheets("Veri").Select
Range("A1:A65536").Select
Selection.Find(What:=ara, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
satir = ActiveCell.Row
Range(Cells(satir, 2), Cells(satir, 8)).Select
Selection.Copy
Sheets("CMK").Select
Range("e8:E10,E12:E29,E11:H11,F6,g32,g33,h31,J4,j32,j33").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
End Sub
2-Bu konuda doğru kodları yazabilirmisiniz.Şimdiden Teşekkürler
 
Son düzenleme:
Üst