Ado Yöntemi İle İstenilen Sütunu çekme

[leonadies]

Merhaba üstadlar;

Ado yöntemi ile genel çekme işini forumdan aldığım aşağıdaki kodlarla yapabiliyorum. İsteğim ise şöyle;

Kapalı.xlsm dosyasından (A-Z) Sütunları arasında sadece istediğim sütunları ve (önreğin 20dakikada bir)
Açık.xlsm dosyasına aktarmak

Nasıl bir çözüm yababilirim?

Private Sub CommandButton1_Click()
Dim conn As Object, rs As Object, sonsat As Long
Set conn = CreateObject("adodb.connection")
Set rs = CreateObject("adodb.recordset")
sonsat = Cells(Rows.Count, "A").End(xlUp).Row + 1
conn.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
        ThisWorkbook.Path & "\dosyam\kapali.xlsm;extended properties=""excel 12.0;hdr=no;imex1"""
rs.Open "select * from [List1$];", conn, 1, 3
Application.ScreenUpdating = False
If rs.RecordCount > 0 Then Range("A" & sonsat).CopyFromRecordset rs
Application.ScreenUpdating = True
rs.Close
conn.Close
Set rs = Nothing: Set conn = Nothing
MsgBox "Veriler aktarıldı."
End Sub

 

[leonadies]

Burada ilaveten şunu yazayım Kapalı K sutununu açıkta M sutununa karşılık getirebilcek yapıda demek istedim.