Çözüldü kapalı dosyadan veri alma mükerrer kayıt engelleme

Sy. Hocalarım ;

Daha önceden Sy. askan ; hocam tarafından kapalı dosyalardan veri alma işlemi kodu yazılmıştı.

Şimdi sizden ricam veri alacağım dosyada veri aktarılacak dosyada H sütünün da mükerrer kayıtları almadan kapalı dosyadan veri çekmek teşekkür ederim.

Not: kod aşağıdadır. Sadece Koda ekleme yapar mısınız.

Sub hareketler()

Dim dsy, son As Long, yol As String, y, i As Integer, s As Integer
'----------yazılacak dosya seçimi----------
dsy = Application.GetOpenFilename(FileFilter:="," & _
".xlsx;.xls;*.xlsm;", _
Title:="Lütfen veriyi aktaracağınız dosya seçiniz seçimi yapınız", MultiSelect:=True)
Application.ScreenUpdating = False
If IsArray(dsy) Then
For i = LBound(dsy) To UBound(dsy)

s = InStr(1, dsy(i), "kolon ayarları toplu", vbBinaryCompare) ' excel dosyasının adı
If s > 0 Then dosya = dsy(i): Call hesap_kesimi_veri_al: s = 0 ' aşağıda yazan makronun adı




Next i
Else
MsgBox "Dosya seçme işleminden vazgeçildi. Tekrar Deneyiniz."
Application.ScreenUpdating = True
Exit Sub
End If
Application.ScreenUpdating = True
End Sub
Sub hesap_kesimi_veri_al()
Dim son As Long, y, i As Long
Workbooks.Open (dosya)
son = ActiveWorkbook.Sheets(1).Range("A" & rows.count).End(xlUp).row ' son satır bulunuyor Sheets(1) burada sayfa numarası soldan kaçıncı sayfa olduğu dikkat et
y = ActiveWorkbook.Sheets(1).Range("A1" & son) 'hangi sütüunları alacağını belirler
ActiveWorkbook.Close False ' verileri aldığımız için dosyayı kapatıyoruz
For i = 3 To UBound ' kaçıncı satırdan itibaren veri alacak
If IsDate(y(i, 1)) Then 'hangi sütunda tarih var ise formatını ayarlıyor
y(i, 1) = Format(y(i, 1), "dd.mm.yyyy hh:mm")
End If
Next i

son = ThisWorkbook.Sheets("HESAP FİŞİ").Range("A" & rows.count).End(xlUp).row + 1 ' yükleme yapılacak excel sayfasının ismi
ThisWorkbook.Sheets("HESAP FİŞİ").Range("A" & son).Resize(UBound, 16) = y ' Resize(UBound, 132) burada 1 den kaça kadar alacağın sütunları belirlersin
End Sub