Kapalı Kitaptan Sütun Başlıklarına Göre Veri Alma Kod Yardımı

[Believing]

Sayın Uzman arkadaşlar,

Aşağıdaki kod yardımı ile kapalı kitaptan, açık olan kitaba veri transferi yapıyorum.

Sub Verileri_Güncelle()
Dim conn As Object, rs As Object, yol As String
Range("A4:AI" & Rows.Count).ClearContents
Set conn = CreateObject("Adodb.Connection")
Set rs = CreateObject("Adodb.Recordset")
'Yol yerine kendi yolunuzu giriniz.
'Bağlanılacak dosya yolunu kontrol ediniz & yol & "\Database_Eğitim_LYRA_HOTEL.xlsx;
'Sayfa ismini kontrol ediniz from [Sayfa1$A1:AI"
yol = ThisWorkbook.Path
conn.Open "Provider=microsoft.ace.oledb.12.0;data source=" & yol & "\Database_Eğitim_LYRA_HOTEL.xlsx;extended properties=""excel 12.0;hdr=yes"";"
rs.Open "Select [kayittarihi], [adisoyadi], [departman], [anagrupadi], [baslangictarihi], [bitistarihi], [gun], [baslangicsaati], [bitissaati], [egtdakika], [toplamdakika] from [Sayfa1$A1:AI" & Rows.Count & "]", conn, 1, 1
If rs.RecordCount > 0 Then Range("A4").CopyFromRecordset rs
rs.Close: conn.Close
End Sub

Kapalı çalışma kitabındaki veriler sürekli güncellendiğinden, açık olan sayfaya güncellenen verileri ilave etmeliyim.
Eski verileri silerek yerine yenilerini yazmasını değil, açık olan kitaptaki sayfanın son dolu satırdan sonraki boş satırdan itibaren verileri yazması için mevcut kodu nasıl revize etmeliyim.
Konuya hakim arkadaşların benim için çok değerli olan yardımlarını rica ediyorum,

Saygılarımla,
Ömer Ali ÜZÜMCÜ

 

[Haluk]

Aşağıdaki satırı silip;

If rs.RecordCount > 0 Then Range("A4").CopyFromRecordset rs

yerine, aşağıdakileri yapıştırın...

If rs.RecordCount > 0 Then
    NoA = Range("A" & Rows.Count).End(xlUp).Row + 1
    Range("A" & NoA).CopyFromRecordset rs
End If

.

 

[Believing]

Sayın Haluk bey,

Konuya göstrediğiniz ilgi ve çözümünüz için size çok teşekkür ederim.
ALLAH sizden ve sevdiklerinizden razı olsun.

Saygılarımla,
Ömer Ali ÜZÜMCÜ

 

[Haluk]

Amin, teşekkürler Ömer Bey.

.