aktar mükerrer kayıt önleme

[putedan]

mutlaka vardır forumda benzer çözümler ama acemilik işte uyarlayamadık kendimize çok acil üstatlar açıklama dosyada basittir aktarma yaparken mükerrer kayıt olmasın ve beni daha önce kaydedildi diye uyarsın istiyorum

 

[Ziynettin]

Merhaba,

Sub aktar()
Dim bak As Range
Dim son As Integer
Set S1 = Sheets("YEDEKAL")
Set S2 = Sheets("YEDEK")
son = S2.Range("A" & Rows.Count).End(3).Row + 1
For Each bak In S2.Range("A2:A" & S2.Range("A" & Rows.Count).End(3).Row)
If bak = S1.Range("A1") Then
MsgBox "Veri kaydı bulunmaktadır.", vbInformation
Exit Sub
End If
Next bak

S2.Cells(son, 1) = S1.Cells(1, 1)
S2.Cells(son, 2) = S1.Cells(1, 2)
S2.Cells(son, 3) = S1.Cells(1, 3)

MsgBox "Kayıt işlemei tamamlandı.", vbInformation
End Sub