Aynı tarihte kayıt varsa uyarı vermek

[mkuru28]

Merhaba arkadaşlar
Ekli örnek çalışma kitabında detaylı olarak anlatmaya çalıştığım gibi DATA sayfasına girilen verileri bir buton yardımı ile DEFTER sayfasına aktarıyorum. Aktarma işlemini yaparken DEFTER sayfasında aynı tarihe daha önce veri girilmişse uyarı almak ve onay verirsem ikinci kaydı yapmak istiyorum. Örnek çalışma kitabı ektedir.

Örnek dosya

 

[Muzaffer Ali]

Merhaba.

Sub kayıtları_aktar()
    Dim Bak As Long
    Dim Bul As Range
    Dim SonSatir As Long
    
    With Worksheets("DEFTER")
        For Bak = 5 To Cells(Rows.Count, "B").End(xlUp).Row
            Set Bul = .Range("B:B").Find(what:=Cells(Bak, "B"), lookat:=xlWhole)
            SonSatir = .Cells(Rows.Count, "B").End(xlUp).Row + 1
            If Bul Is Nothing Then
               .Range("B" & SonSatir & ":N" & SonSatir).Value = Range("B" & Bak & ":N" & Bak).Value
               Range("B" & Bak & ":N" & Bak).Value = ""
            Else
                If MsgBox(Cells(Bak, "B") & " bu tarih DEFTER sayfasında zaten var, yine de aktarmak ister misiniz?" & vbQuestion, vbYesNo) = vbYes Then
                    .Range("B" & SonSatir & ":N" & SonSatir).Value = Range("B" & Bak & ":N" & Bak).Value
                    Range("B" & Bak & ":N" & Bak).Value = ""
                End If
            End If
        Next
    End With
End Sub

 

[catalinastrap]

Sanırım böyle bir şey istediniz

ornek.xlsm dosyasını indir - download

ornek.xlsm dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

www.dosya.tc

 

[mkuru28]

Her iki kod da süper çalışıyor. Emeğinize sağlık arkadaşlar. Teşekkür ederim.