Kapalı Dosyadan Tarih Sıralı Veri Alma Kod Yardımı

[Believing]

Sayın Uzman Arkadaşlar,

Aşağıdaki kodlar yardımı ile kapalı dosyadan açık olan dosyaya veri alıyorum. Kapalı dosyanın "D" sütununda kayıt tarihleri bulunmaktadır. Tarih sıralı olarak veri aldığımızı düşünerek, aşağıdaki kodları ne şekilde düzenlemeliyiz? Kodlar çok değerli bir arkadaştan alıntı olup, sizlerin benim için çok değerli yardımlarını rica ediyorum.

Saygılarımla .

Sub ac_veri_al_kapa()
Application.ScreenUpdating = False
Set buk = ThisWorkbook
Set s1 = buk.Sheets("Veritabanı")
Set ktp = Workbooks.Open(ThisWorkbook.Path & "\DATA_(Extra Posting).xls")
Set s2 = ktp.Sheets("Sheet1")
Dim ss1, ss2 As Integer
ss1 = s1.Range("A" & Rows.Count).End(3).Row
ss2 = s2.Range("P" & Rows.Count).End(3).Row
Dim rng As Range
Set rng = s2.Range("A3:P" & ss2)
rng.Copy s1.Cells(ss1 + 1, 2)
ktp.Close False
Application.ScreenUpdating = True
End Sub

 

[alicimri]

Denemeden önce dosyanızı yedekleyin. Dosyanızdaki ilgili sayfa D sütunundaki tarihe göre sıralanacaktır. Eğer normalinde başka bir sütununa göre sıralı ise aynı kodu kopyalama işlemi bittikten sonra değiştirerek eski haline getirebilirsiniz.

rng.Sort key1:=s2.Range("d3:d" & ss2), order1:=xlAscending, Header:=xlNo

Yukardaki kodu aşağıdaki satırın hemen üzerine yapıştırın.

rng.Copy s1.Cells(ss1 + 1, 2)

 

[Believing]

Sayın Ali bey,

Öncelikle konuya gösterdiğiniz ilgi ve yardım için size çok teşekkür ederim.
Aynı istekleri Sayfadaki UserForm için kullandığımız kodlar da uygulamak istiyorum. Son kez bir yardım daha rica edebilir miyim?

Saygılarımla,

Private Sub CommandButton1_Click()
Set vt = Sheets("Veritabanı")
Set rpr = Sheets("RAPOR")
rpr.Range("A4:P" & Rows.Count).Cells.ClearContents
Dim ss As Integer
For i = 3 To vt.Range("A" & Rows.Count).End(3).Row
If Format(vt.Cells(i, "E"), "yyyy.mm.dd") >= Format(TextBox1, "yyyy.mm.dd") And Format(vt.Cells(i, "E"), "yyyy.mm.dd") <= Format(TextBox2, "yyyy.mm.dd") Then
For g = 0 To ListBox1.ListCount - 1
If Me.ListBox1.Selected(g) = True Then
    If Me.ListBox1.List(g) = vt.Cells(i, "F") Then
        ss = rpr.Range("A" & Rows.Count).End(3).Row
        rpr.Cells(ss + 1, 1) = vt.Cells(i, 1) 'sno
        rpr.Cells(ss + 1, 3) = vt.Cells(i, 2) 'room
        rpr.Cells(ss + 1, 4) = vt.Cells(i, 3) 'folio
        rpr.Cells(ss + 1, 5) = vt.Cells(i, 4) 'guestname
        rpr.Cells(ss + 1, 2) = vt.Cells(i, 5) 'date
        rpr.Cells(ss + 1, 6) = vt.Cells(i, 6) 'departname
        rpr.Cells(ss + 1, 7) = vt.Cells(i, 7) 'amount
        rpr.Cells(ss + 1, 8) = vt.Cells(i, 8) 'curr
        rpr.Cells(ss + 1, 9) = vt.Cells(i, 9) 'rate
        rpr.Cells(ss + 1, 10) = vt.Cells(i, 12) 'local
        rpr.Cells(ss + 1, 11) = vt.Cells(i, 13) 'revenue
        rpr.Cells(ss + 1, 12) = vt.Cells(i, 14) 'user
        rpr.Cells(ss + 1, 13) = vt.Cells(i, 15) 'checkno
        rpr.Cells(ss + 1, 15) = vt.Cells(i, 16) 'remark
        rpr.Cells(ss + 1, 14) = vt.Cells(i, 17) 'nationality
        rpr.Cells(ss + 1, 16) = vt.Cells(i, 18) 'excplanation
    End If
End If
Next
End If
Next
End Sub

 

[alicimri]

örnek dosya eklerseniz, ben veya başka bir arkadaş yardımcı oluruz.