Soru Makro birleştirme

[Sefa1994]

Merhabalar, Dün Bi arkadaşımız güncelle butonu ile benzersiz veri aktarımı hakkında yardımcı olmuştu ve aşağıda ki kodu yazmıştı tekrar ondan yardım isteyip rahatsız etmek istemedim o yüzden size sorayım dedim. Bu kodda sayfa 1 deki b sütununda olan benzersiz verileri sayfa 2 de ki a40 ve altına benzersiz olanları ekliyordu tekrar edilenleri eklemiyordu. Ben bununla beraber safa 1 deki b sütunun yanında I sütununda olan yazıları da sayfa 2 de ki b 40 ve altına yazdırmak istiyorum. şöyle ki; sayfa 1 b sütunu ve onun yanında yazan I sütununda ki veriyi sayfa 2 de a 40 ve yanında b 40 a ekle yardımcı olabilirseniz çok sevinirim. isteyene excel şablonunu da gönderirim. şimdiden teşekkürler..

Sub aktar()
Dim son
Dim son2
Dim i
son = Sheets("Sayfa1").Cells(Rows.Count, 2).End(3).Row
son2 = Sheets("Sayfa2").Cells(Rows.Count, 1).End(3).Row
If son2 >= 39 Then GoTo atla:

Sheets("Sayfa2").Range("a40:a" & son2).ClearContents
atla:
For i = 2 To son
son2 = Sheets("Sayfa2").Cells(Rows.Count, 1).End(3).Row
If WorksheetFunction.CountIf(Sheets("Sayfa2").Range("a1:a" & son2), Sheets("Sayfa1").Cells(i, 2)) = 0 Then
Sheets("Sayfa2").Cells(son2 + 1, 1).Value = Sheets("Sayfa1").Cells(i, 2).Value
End If

Next
End Sub