Çözüldü Kritere Göre Kapalı Dosyadan Veri Alma,

[gicimi]

Merhaba;
Kapalı dosyadaki verileri belirtilen kritere göre Açık dosyaya A-B-C-D sütundaki bilgileri aktarılması konusunda desteklerinizi rica ederim.
Kapalı Dosya Satır Sayısı: 50.000

 

[Orion1]

Buyurun.

DOSYAYI INDIR

Sub verial_ado()
Dim con As Object, rs As Object
Set con = CreateObject("Adodb.connection")
Set rs = CreateObject("Adodb.recordset")
con.Open "Provider=microsoft.ace.oledb.12.0;data source=" & ThisWorkbook.Path & _
        "\Kapalı Dosya.xlsx;extended properties=""excel 12.0;hdr=yes"""
rs.Open "select * from[Sheet1$] where [Gönderilen BÖLGE]='" & Range("B1").Value & "';", con, 1, 3
Application.ScreenUpdating = False
Range("A4").CopyFromRecordset rs
Application.ScreenUpdating = True
rs.Close: con.Close
Set rs = Nothing: Set con = Nothing
MsgBox "Veriler alındı."
End Sub

 

[gicimi]

@Orion1 Hocam elinize sağlık teşekkür ederim.

 

[Orion1]

Rica ederim.
İyi çalışmalar.