Tarih ve sağındaki hücreyi kopyalama

[steppe]

Merhaba Arkadaşlar,
A sütununda tarihler var (aynı tarihten birden fazla), B sütununda şehirler var. İstediğim A sütunundaki ilk tarih ve sağındaki şehri D Sütununa ve E Sütununa yazdırmak.

Örnek:

A B
---- ----
01.03.2020 Adana
01.03.2020 Adıyaman
02.03.2020 Aksaray
02.03.2020 Amasya
02.03.2020 Ankara
03.03.2020 Aydın
03.03.2020 Balıkesir
03.03.2020 Bartın
03.03.2020 Batman

Şeklindeki verileri

D E
--------- -------
01.03.2020 Adana
02.03.2020 Amasya
03.03.2020 Aydın

Şeklinde yazdırmak. örnek dosya ektedir.Yardımlarınız için şimdiden teşekkür ederim.

 

[Ziynettin]

Sub kod()
Sheets("Sayfa1").Select
son = Range("A" & Rows.Count).End(xlUp).Row
a = Range("A1:B" & son).Value
Set dc = CreateObject("scripting.dictionary")
    For i = 1 To UBound(a)
        If Not dc.exists(a(i, 1)) Then dc(a(i, 1)) = a(i, 2)
    Next i
    Range("D2:E" & Rows.Count) = ""
    If dc.Count > 0 Then
    [D2].Resize(dc.Count, 2) = Application.Transpose(Array(dc.keys, dc.items))
    End If
MsgBox "İşlem tamam.", vbInformation
End Sub

 

[steppe]

Ziynettin Hocam,
Yardımlarınız için çok teşekkür ederim.