Aktarma Yapılacak Veriler Aynı ise uyarı ver

[bezl]

aşağıdaki kodla verileri ikinci sayfaya kopyalatıyorum ama kopyalanacak veriler son kopyalananla aynı ise bir uyarı vermesini kabul edilirse yeniden kopyalanmasını istiyorum yardımcı olursanız sevinirim.

Sub aktar()
sat = WorksheetFunction.CountA(Sheets(2).[a2:a65536]) + 1
MsgBox "Sayfa2'ye kayıt yapılsın mı?", 32 + 4, "ONAY"
Application.ScreenUpdating = False
If Sheets(2).Cells(sat, 1).Value = Sheets(1).Range("a1").Value And Sheets(2).Cells(sat, 2).Value = Sheets(1).Range("b1").Value And Sheets(2).Cells(sat, 3).Value = Sheets(1).Range("c1").Value And Sheets(2).Cells(sat, 4).Value = Sheets(1).Range("d1").Value Then
GoTo 20
Else
Sheets(1).Range("a2:d2").Copy
Sheets(2).Cells(sat + 1, 1).PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
Application.ScreenUpdating = True
MsgBox "Kayıt yapıldı."
End If
20 End Sub

 

[bezl]

Yardım edecek yok mu?

 

[bezl]

Sabreden derviş muradına ermiş...

 

[bezl]

İnşaallah...

 

[bezl]

Bu konuda birşey söyleyebilecek yok mu?

 

[Levent Menteşoğlu]

Aşağıdaki gibi deneyin.

[vb:1:be1465641d]Sub aktar()
Application.ScreenUpdating = False
Set s1 = Sheets(1)
Set s2 = Sheets(2)
sat = WorksheetFunction.CountA(Sheets(2).[a2:a65536]) + 1
deg = s1.[a2] & s1.[b2] & s1.[c2] & s1.[d2]
kayit = s2.Cells(sat, 1) & s2.Cells(sat, 2) & s2.Cells(sat, 3) & s2.Cells(sat, 4)
If deg = kayit Then sor = MsgBox("Sayfa2'ye kayıt yapılsın mı?", 32 + 4, "ONAY")
If sor = vbNo Then Exit Sub
Sheets(1).Range("a2:d2").Copy
Sheets(2).Cells(sat + 1, 1).PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
MsgBox "Kayıt yapıldı."
End Sub
[/vb:1:be1465641d]

 

[bezl]

Sayın leventm cevabınız için çok teşekkür ederim.
Ama tamamen aynısı olsa bile hemen kayıt ediyor.
örnek dosya ekte

 

[bezl]

İnşaallah Bugün bir çözüm buluruz.

 

[Levent Menteşoğlu]

Aşağıdaki gibi deneyin.

[vb:1:d5343a3a12]Sub aktar()
Application.ScreenUpdating = False
Set s1 = Sheets(1)
Set s2 = Sheets(2)
sat = WorksheetFunction.CountA(Sheets(2).[a2:a65536]) + 1
deg = s1.[a2] & s1.[b2] & s1.[c2] & CDbl(s1.[d2])
kayit = s2.Cells(sat, 1) & s2.Cells(sat, 2) & s2.Cells(sat, 3) & CDbl(s2.Cells(sat, 4))
If deg = kayit Then sor = MsgBox("Sayfa2'ye kayıt yapılsın mı?", 32 + 4, "ONAY")
If sor = vbNo Then Exit Sub
Sheets(1).Range("a2:d2").Copy
Sheets(2).Cells(sat + 1, 1).PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
MsgBox "Kayıt yapıldı."
End Sub
[/vb:1:d5343a3a12]

 

[bezl]

Teşekkür ederim.