Aktar Makrosunda mükerrer

[byak]

Sub YAZDIR_AKTAR()
'ActiveWindow.SelectedSheets.PrintOut Copies:=1
With Sheets("LİSTE")
ActiveSheet.Unprotect
Satir = .Cells(Rows.Count, 1).End(3).Row + 1
.Cells(Satir, 1) = Satir - 1
.Cells(Satir, 2) = Range("S1")
.Cells(Satir, 3) = Range("AO1")
.Cells(Satir, 4) = Range("BJ1")
.Cells(Satir, 5) = Range("DA19")
.Cells(Satir, 8) = Range("CS57")
.Cells(Satir, 9) = Range("CS56")
.Cells(Satir, 10) = Range("DH55")
.Cells(Satir, 14) = Range("DH1")


'ActiveSheet.Protect
End With
'MsgBox "İSTENEN BİLGİLER LİSTE SAYFASINA AKTARILDI."
End Sub

Bu kodla sayfa 1 den liste sayfasına kayıt yapıyorum. Kayıt yaparken liste sayfasında aynı kayıt varsa yeni verileri eskisinin yerine yazdırmak istiyorum. Yeni veri kayıtlı değilse en son boş satırdan devam ederek alt alta kayıt yapması için ilgili kodda nasıl bir değişiklik yapabiliriz.
Yardımlarınızı bekliyorum acil.
Teşekkürler

 

[byak]

Üstadlar yardım

 

[dEdE]

Merhaba,
"...Kayıt yaparken liste sayfasında aynı kayıt varsa "... sorun burada. Aynı kaydın olup olmadığını yukarıdaki koda bakarak sorgulamak istersek bütün hücreleri karşılaştırmamız lazım. Bu da veri miktarına bağlı olarak çok uzun sürebilir ve bazende sistemi zorlaması nedeniyle sorun çıkarabilir.
Kayıtlarınız arasında ayrıcı özelliğie sahip bir alan varsa (kimlik no, kod no, seri no gibi) sorun daha kolay aşılır.
Özet: Örnek dosya eklerseniz daha çabuk yanıt alırsınız.

 

[byak]

Aktar Makrosunda Yardım

Hocam teşekkür ederim.
İlgili dosyayı ekliyorum.

 

[dEdE]

Merhaba,
Mevcut kodunuzu aşağıdaki ile değiştirip dener misiniz?
Kod üzerinde sizin devre dişı bıraktığınız(' ile) satırlara dokunmadım. Onları kullanıp kullanmaycağınızı sizbilirsiniz.

Sub YAZDIR_AKTAR()
Set s1 = Sheets("BORDRO")
Set s2 = Sheets("LİSTE")
'ActiveWindow.SelectedSheets.PrintOut Copies:=1
Set Aranan = s2.Range("N:N").Find(s1.[U8].Value, , xlValues, xlWhole)
    If Not Aranan Is Nothing Then
       Satir = Aranan.Row
    Else
        Satir = s2.Cells(Rows.Count, 1).End(3).Row + 1
    End If
With s2
    ActiveSheet.Unprotect
    .Cells(Satir, 1).Value = Satir - 1
    .Cells(Satir, 2).Value = Range("F8").Value 'İSİM
    .Cells(Satir, 3).Value = Range("J8").Value 'İL
    .Cells(Satir, 4).Value = Range("I8").Value 'İLÇE
    .Cells(Satir, 5).Value = Range("T27").Value 'BRÜT
    '.Cells(Satir, 8).Value = Range("AN21").Value 'GEZİ
    '.Cells(Satir, 9).Value = Range("AN23").Value 'UÇAK
    '.Cells(Satir, 10).Value = Range("AN22").Value 'OTEL ÜCRET
    .Cells(Satir, 14).Value = Range("U8").Value 'BORDRO
    'ActiveSheet.Protect
End With
    'MsgBox "İSTENEN BİLGİLER LİSTE SAYFASINA AKTARILDI."
End Sub

 

[byak]

Çok teşekkür ederim sayın dede. Mükemmel olmuş. Ellerinize sağlık.