Son Hücrelere Yazma!

[ali_simsek]

Arkadaşlar dosyada sayfa1 de bulunan listelerin karşılarına kişilerin aldığı eğitimleri işliyorum. Sayfa2 de ise yeni eğitim alanlar var.
Sayfa2 de eğitim alanlar sayfa1 de bulunan isimlerin karşısındaki ait olduğu satırın son hücresine nasıl getirilir?

Yardımlarınızı bekliyorum.

İlginiz için teşekkürler.

 

[Orion1]

Dosyanzı ekte.
Ayni isimden bulunmasa en alta yeni simi oluşturuyor.

Sub aktar()
Dim i As Long, sat As Long, k As Range, sat2 As Long, s As Worksheet
Application.ScreenUpdating = False
Set s = Sheets("Sayfa1")
sut = s.Cells(1, 256).End(xlToLeft).Column
sat = Cells(65536, "A").End(xlUp).Row
sat2 = s.Cells(65536, "A").End(xlUp).Row + 1
For i = 2 To sat
    Set k = s.Range("A2:A65536").Find(Cells(i, "A").Value, , xlValues, xlWhole)
    If Not k Is Nothing Then
        s.Cells(k.Row, sut).Value = Cells(i, "B").Value
        Else
        s.Cells(sat2, "A").Value = Cells(i, "A").Value
        s.Cells(sat2, sut).Value = Cells(i, "B").Value
        sat2 = sat2 + 1
    End If
Next i
Application.ScreenUpdating = True
MsgBox "Aktarma tamamlandı." & vbLf & vbLf & _
"evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
        

End Sub