Sayfalar Arası Veri Karşılaştırma

[gfbserhat]

Merhaba Arkadaşlar,

Bir excel dosyasının iki farklı sayfasındaki tarihi güncel olan veriyi aynı excel'in 3. sayfasına kopyalamak istiyorum. Fakat bir türlü başaramadım.

Ekteki Excel'in Gelen ve Giden sayfasındaki verileri karşılaştırıp en yeni tarihli veriyi Güncel sayfasına kopyalamak ve hangi sayfadan geldiğini anlayabilmem içinde F sutununa ilgili sayfa adını yazdırmam gerek. Örnek olarak gönderdiğim dosya yapmak istediğimin manuel yapılmış hali. Bunu otomatikleştirmek istiyorum. Yardımlarınız için şimdiden teşekkürler.

 

[gfbserhat]

Arkadaşlar,

Yardımcı olabilecek kimse yok mu acaba ?

 

[gfbserhat]

Bu yapılabilir mi ?

Yardımlarınızı rica ederim.

 

[Orion1]

Dosyanız aşağıdaki linktedir.

DOSYAYI İNDİR

Sub guncel59()
Dim k As Range, tarih As Date, sat As Long, sh As Worksheet
Set sh = Sheets("Güncel")
sat = sh.Cells(Rows.Count, "A").End(xlUp).Row + 1
tarih = WorksheetFunction.Max(Sheets("Gelen").Range("A2:A" & Rows.Count))
Set k = Sheets("Gelen").Range("A2:A" & Rows.Count).Find(tarih, , xlValues, xlWhole)
If Not k Is Nothing Then
    Sheets("Gelen").Range("A" & k.Row & ":E" & k.Row).Copy sh.Range("A" & sat)
    sh.Range("F" & sat).Value = "Gelen"
    sh.Range("F" & sat).Font.Color = vbRed
    sh.Range("F" & sat).Font.Bold = True
End If
sat = sh.Cells(Rows.Count, "A").End(xlUp).Row + 1
tarih = WorksheetFunction.Max(Sheets("Giden").Range("A2:A" & Rows.Count))
Set k = Sheets("Giden").Range("A2:A" & Rows.Count).Find(tarih, , xlValues, xlWhole)
If Not k Is Nothing Then
    Sheets("Giden").Range("A" & k.Row & ":E" & k.Row).Copy sh.Range("A" & sat)
    sh.Range("F" & sat).Value = "Gelen"
    sh.Range("F" & sat).Font.ColorIndex = 10
    sh.Range("F" & sat).Font.Bold = True
End If
Set sh = Nothing
MsgBox "Güncel Veriler Akatarıldı." & vbLf & "evrengizlen@hotmail.com"
End Sub