Kapalı dosyadaki sayfalardan veri alma

[kemal turan]

Merhaba,
Tek bir veritabanı ve çoklu kullanıcılı bir yapı için Sn. Veysel Emre hocamızın bugün bir soruya verdiği cevaptan ışık alarak
kapalı dosyadan veri almada mevcut kodu kendime uyarladım.
Burada ANASAYFA çalışma kitabına VERILER çalışma kitabından "verıler" sayfasından veri alabildim.
Diğer sayfalardan da ( "sayfa1" , "sayfa2""sayfa3""sayfa4""sayfa5" ) verileri tek bir kodla almak için mevcut koda ilave yardım rica ediyorum.
Teşekkür ederim.

Sub veriCek()
    Dim adoCn As Object, rs As Object, kaynakAdres, hedefAdres, strSQL$
    Set adoCn = CreateObject("ADODB.Connection")
    adoCn.Provider = "Microsoft.ACE.OLEDB.12.0"
    adoCn.Properties("Data Source") = ThisWorkbook.FullName
    adoCn.Properties("Extended Properties") = "Excel 12.0; HDR=No"
    adoCn.Open
    Set rs = CreateObject("Adodb.RecordSet")
    dosyalar = Array("VERITABANI")
    kaynakAdres = Array("A2:S65536")
    hedefAdres = Array("A2:S65536")

    Sheets("verıler").Range(hedefAdres(i)).ClearContents

    strSQL = "Select * From [verıler$" & kaynakAdres(i) & "] IN '' [Excel 12.0;HDR=No;Database=" & ThisWorkbook.Path & "\" & _
             dosyalar(i) & ".xlsx]"
    rs.Open strSQL, adoCn, 1, 1
    Sheets("verıler").Range(hedefAdres(i)).CopyFromRecordset rs
    rs.Close

    adoCn.Close
    Set rs = Nothing
    Set adoCn = Nothing
End Sub

 

[Korhan Ayhan]

Kemal Bey,

Veriler nasıl aktarılacak. Her seferinde sayfadaki eski bilgiler silinip yenileri mi aktarılacak?

 

[kemal turan]

Evet Korhan hocam

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub Verileri_Aktar()
    Dim Zaman As Double, Hedef_Dosya As String, Sayfa As Worksheet
    Dim Baglanti As Object, Kayit_Seti As Object, Sorgu As String
  
    Zaman = Timer
  
    Application.ScreenUpdating = False
  
    Set Baglanti = CreateObject("AdoDb.Connection")
    Set Kayit_Seti = CreateObject("AdoDb.Recordset")
      
    Sheets("verıler").Range("A2:S" & Rows.Count).ClearContents
    Sheets(Array("sayfa1", "Sayfa2", "Sayfa3", "Sayfa4", "Sayfa5")).Select
    Range("A2:E" & Rows.Count).ClearContents
    Sheets("verıler").Select
    
    Hedef_Dosya = ThisWorkbook.Path & Application.PathSeparator & "VERITABANI.xlsx"
    
    Baglanti.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
    Hedef_Dosya & ";Extended Properties=""Excel 12.0;Hdr=Yes"""
    
    For Each Sayfa In ThisWorkbook.Worksheets
        Sorgu = "Select * From [" & Sayfa.Name & "$]"
        Kayit_Seti.Open Sorgu, Baglanti, 1, 1
        Sayfa.Range("A2").CopyFromRecordset Kayit_Seti
        Sayfa.Columns.AutoFit
        If Kayit_Seti.State <> 0 Then Kayit_Seti.Close
    Next
    
    If Baglanti.State <> 0 Then Baglanti.Close
  
    Set Kayit_Seti = Nothing
    Set Baglanti = Nothing
          
    Application.ScreenUpdating = True
          
    MsgBox "Veri aktarımı tamamlanmıştır." & vbLf & vbLf & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub

 

[kemal turan]

Korhan Hocam,
Çok teşekkür ederim.
Selametle kalınız.