Soru Sayfadan Sayfaya Aktar

[sirkülasyon]

Dim S1 As Worksheet, S2 As Worksheet, Son, Sn As Long
Application.ScreenUpdating = False
Set S1 = Sheets("Bordro")
Set S2 = Sheets("Arşiv")
Son = S1.Cells(S1.Rows.Count, 2).End(3).Row
If Son > 1 Then
S1.Range("B2:X" & Son).Copy
With S2.Cells(S2.Rows.Count, 2).End(3)(2, 1)
.PasteSpecial xlValues
.PasteSpecial xlFormats
End With
S2.Range("B2:X" & S2.Rows.Count).Sort S2.Range("B2"), xlAscending
S2.Select
S2.Range("B2").Select
S1.Select
Application.CutCopyMode = False
Application.ScreenUpdating = True
S2.Range("B2:X" & Son).Sort S2.Range("B2"), xlAscending, S2.Range("B2"), , xlAscending
ApplicationEnableEvents = True
On Error GoTo 10
Sn = S2.Cells(Rows.Count, "B").End(3).Row
With S2.Range("A2:A" & Sn)
.Formula = "=COUNTIF(B$2:B2,B2)"
.Value = .Value
End With
10
MsgBox "Veri aktarımı tamamlanmıştır.", vbInformation
Else
MsgBox "Aktarılacak veri bulunamadı!", vbExclamation
End If
Set S1 = Nothing
Set S2 = Nothing
Application.ScreenUpdating = True
End Sub

Ustam Yukarıda yer alan Bordro Sayfasından Arşiv Sayfasına Aktaran koda B2:X aralığına aktarılan veri birebir aynısı ise uyarı versin "Mükerrer Aktarma!... Devam edeyim mi?" Evet ise aktarsın Hayır ise aktarmasın şeklinde düzenleme için yardımcı olabilir misiniz?

 

[Korhan Ayhan]

Mantık olarak aktarım esnasında aktarılan verinin yanındaki boş bir alana AKTARILDI gibi bir ifade yazdırırsanız daha efektif çözüme gidebilirsiniz. Daha sonraki aktarımlarda AKTARILDI yazılmayanları süzerek aktarım yaparsanız mükerer kayıt kontrolü yapmanıza gerek kalmaz.

Diğer türlü diyelim ki 1000 satırlık bir veri aktardınız. İkinci aktarımda bu verilerin hangisinin mükerrerliği kontrol edilecek. Bu işleri daha karmaşık hale getirmekten başka bir işe yaramayacaktır. Her zaman pratik düşünmekte fayda var.