kapalı farklı bir dosyadan veri çekmek

[hakanbarcin]

şablon dosyasına (kırmızı punto) , liste dosyasındaki (aynı sutun adındaki) belirli sütünları almak istiyorum. liste dosyası kapalı olsada. bu konuda bana yardımcı olabilir misiniz?

 

[ramazankaya89]

Almak istediğiniz hücreler aynı sıralamada yeralıyor ise = ile seçerek kaydedip dosyayı kapatabilirsiniz dosya ag yada başka bir bilgisayarda yerlalmıyor ise mevcut dosyada daima o değerleri görecektir

 

[hakanbarcin]

liste dosyasında sıralama değişiyor ama şablon sabit hata veriyor sutun başlıgına göre eşit olanları alması yeterlı kırmızı olanları

 

[Korhan Ayhan]

Merhaba,

İki dosyanızı aynı klasöre aldıktan sonra aşağıdaki kodu deneyiniz.

Option Explicit

Sub Aktar()
    Dim My_Connection As Object, My_Recordset As Object, My_Query As String
 
    Application.ScreenUpdating = False
 
    Set My_Connection = CreateObject("AdoDB.Connection")
    Set My_Recordset = CreateObject("ADODB.Recordset")
 
    Range("A2:B" & Rows.Count).ClearContents
    Range("F2:F" & Rows.Count).ClearContents
    Range("J2:K" & Rows.Count).ClearContents
    Range("S2:S" & Rows.Count).ClearContents
   
    My_Connection.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
    ThisWorkbook.Path & "\liste.xlsx" & ";Extended Properties=""Excel 12.0;Hdr=No;Imex=1"""
 
    My_Query = "Select F2,F1 From [Sayfa1$A2:F] Where F1 Is Not Null"
    My_Recordset.Open My_Query, My_Connection, 1, 1
    Range("A2").CopyFromRecordset My_Recordset
    My_Recordset.Close
   
    My_Query = "Select F4 From [Sayfa1$A2:F] Where F1 Is Not Null"
    My_Recordset.Open My_Query, My_Connection, 1, 1
    Range("F2").CopyFromRecordset My_Recordset
    My_Recordset.Close
   
    My_Query = "Select F3,F5 From [Sayfa1$A2:F] Where F1 Is Not Null"
    My_Recordset.Open My_Query, My_Connection, 1, 1
    Range("J2").CopyFromRecordset My_Recordset
    My_Recordset.Close
   
    My_Query = "Select F6 From [Sayfa1$A2:F] Where F1 Is Not Null"
    My_Recordset.Open My_Query, My_Connection, 1, 1
    Range("S2").CopyFromRecordset My_Recordset
    My_Recordset.Close
  
    Columns.AutoFit
  
    My_Connection.Close
 
    Set My_Recordset = Nothing
    Set My_Connection = Nothing
 
    Application.ScreenUpdating = True
 
    MsgBox "İşleminiz tamamlanmıştır"
End Sub

 

[hakanbarcin]

öncelikle ilginiz için tşk ederim. liste dosyasındaki sıralama değişince hata veriyor. burada şöyle bir düzeltme yapılabilir mi? liste dosyasındaki başlık (mesala kod) ismini şablonda bulup o sutunu oraya aktarabileçek şekilde düzenlenebilir mi? liste dosyasındaki sutunlar sabit olmayacak.ayrıca bazı liste dosyalarım 100 satır bazılarıda 2000 satır şeklinde hesaplamayı otomatik olarak yaptırabilirmiyiz. ayrıca şablon dosyasına yeni bir liste çekmek istediğide önceki verileri sildikten sonra yeni veriyi alsın.100 satır var ise 101 satırı hesaplamayacak ama liste dosyam 2000 satır veya daha fazla isede yine bu satırları hesaplayabilecek boyle yapılabilir mi?

 

[hakanbarcin]

dosyamın son şekli ekte. dosyanı eksikliği sadece liste adlı dosyamda adı kod birim barkod fiyat sütünlarının yerleri değişiklik gösteriyor şablon dosyasına veri alırken verileri aynı isimli sutunları bulup oraya veriyi atmasını istiyorum bunun için ne yapılması gerekiyor

 

[Korhan Ayhan]

Başlık isimlerini kullanacaksanız bağlantıdaki No parametresini Yes olarak ayarlamanız yeterli olacaktır. Sonrasında sorgu satırlarında sütun başlıklarını kullanabilirsiniz. Fakat burada dikkat etmeniz gereken nokta ise sütun başlığını aynen yazmanız gerekiyor.

Option Explicit

Sub Aktar()
    Dim My_Connection As Object, My_Recordset As Object, My_Query As String
    
    Application.ScreenUpdating = False
 
    Set My_Connection = CreateObject("AdoDB.Connection")
    Set My_Recordset = CreateObject("ADODB.Recordset")
 
    Range("A2:B" & Rows.Count).ClearContents
    Range("F2:F" & Rows.Count).ClearContents
    Range("J2:K" & Rows.Count).ClearContents
    Range("S2:S" & Rows.Count).ClearContents
   
    My_Connection.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
    ThisWorkbook.Path & "\liste.xlsx" & ";Extended Properties=""Excel 12.0;Hdr=Yes;Imex=1"""
 
    My_Query = "Select [Kod],[Adı] From [Sayfa1$] Where [Kod] Is Not Null"
    My_Recordset.Open My_Query, My_Connection, 1, 1
    Range("A2").CopyFromRecordset My_Recordset
    My_Recordset.Close
   
    My_Query = "Select [KDV_ oranı] From [Sayfa1$] Where [Kod] Is Not Null"
    My_Recordset.Open My_Query, My_Connection, 1, 1
    Range("F2").CopyFromRecordset My_Recordset
    My_Recordset.Close
   
    My_Query = "Select [Birim],[Barkod] From [Sayfa1$] Where [Kod] Is Not Null"
    My_Recordset.Open My_Query, My_Connection, 1, 1
    Range("J2").CopyFromRecordset My_Recordset
    My_Recordset.Close
   
    My_Query = "Select [Fiyatı] From [Sayfa1$] Where [Kod] Is Not Null"
    My_Recordset.Open My_Query, My_Connection, 1, 1
    Range("S2").CopyFromRecordset My_Recordset
    My_Recordset.Close
  
    Columns.AutoFit
  
    My_Connection.Close
 
    Set My_Recordset = Nothing
    Set My_Connection = Nothing
 
    MsgBox "İşleminiz tamamlanmıştır"
End Sub

 

[hakanbarcin]

ilginiz için tşk ederim.