Sütun Başlığına Göre Veri Aktarma

[Ahmet Sami]

İyi günler arkadaşlar, excel de VERİ sayfasında B,C,D,E,F,G sütunlarında bulunan başlıklara göre ANASAYFA'da B1 deki yazacağım sütun başlığına göre B2 İLE G2 sütunlarına hangi sütun başlığına göre aktarma yaparsam oraya ilgili sütunu ve diğer sütunları aktarsın istiyorum.

Örnek olarak; B C D E F G
SERİNO MALZ.ADI İL İLÇE KÖY MAHALLE
123 PC ANKARA POLATLI - -
456 YAZICI - ÇANKAYA - DİKMEN
789 PC MERSİN MERKEZ - -
Burada ANASAYFA B1 hücresine İL yazdığım zaman ANKARA ve MERSİN ile birlikte diğer sütunlardaki tüm bilgileri aktarsın ancak İL sütunundaki boş olan tüm satırı aktarmasın istiyorum şimdiden teşekkür ederim.

 

[Erdem Akdemir]

Örnek dosya ekleyebilir misiniz.

 

[Ahmet Sami]

http://www.dosya.tc/server16/hyulmq/Sutuna_Gore_Aktar.xls.html

Buyurun örnek liste ekledim.

 

[Erdem Akdemir]

Merhaba,

Aşağıdaki kodu dener misiniz.

Sub illl()

Sayfa1.Range("A3:G1000").ClearContents

Set con = VBA.CreateObject("adodb.Connection")

con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=yes"""

deg = Sayfa1.Range("B1")

sorgu = "select * from[VERİ$] where " & deg & " is not null "
Set rs = con.Execute(sorgu)
Range("A3").CopyFromRecordset rs

End Sub

 

[Ahmet Sami]

Çok teşekkür ederim. İşime yaradı sağolun emeğinize sağlık

 

[Erdem Akdemir]

Rica ederim, iyi çalışmalar.

 

[Ahmet Sami]

Erdem Bey, deneme olarak gönderdiğim örnekte çalışıyordu ancak kendi çalışma kitabıma uyguladığımda co.open "provider.... ile başlayan iki saterdaki yerleri sarı renkli yaparak hata veriyor yardımcı olursanız sevinirim

 

[Erdem Akdemir]

Dosyanızı görmeden bir şey diyemem.

 

[Ahmet Sami]

Erdem Bey yukarıya eklemiştim. 3. Mesajımda dosya mevcut

 

[Erdem Akdemir]

Hata veren dosyanızı görmem lazım. Eklediğiniz örnekte çalışıyor demiştiniz.

 

[Ahmet Sami]

Arkadaşlar kolay gelsin, sizlerin yardımı ile listeyi oluşturabiliyorum. Ancak VERİ sayfasında yer alan sütunların tamamı geliyor oysaki ben istediğim sütunların burada yer almasını istiyorum. Ayrıca B1 de yer alan aktarma başlığına göre arattırılan başlık baştan başlaya bilirmi
Mesela; İL başlığına aktarma yaptığım zaman İL sütunu B3 ten başlasın yani İL SERİ NO, MALZEMENİN ADI..... GİBİ
MAHALLE sütununa aktarma yapıldığı zaman MAHALLE b3 ten başlasın ve diğerleri de onu takip ederek C,D,E,F,G gibi aktarılsın

ikinci bir sıkıntım ise aynı kodları başka sayfalara uyarlamaya çalıştığım zaman hata alıyorum.
Set rs = con.Execute(sorgu) sarı renkli oluyor.
örnek olarak. kodda yer alan
Sayfa1.Range("A3:E50")..... ile başlayan yerdeki Sayfa1 'in yerine Sayfa5 'te uygulamaya çalıştığım zaman hata veriyor
Yardımlarınızı esirgemeyeceğinizi biliyorum. Şimdiden teşekkür ederim

 

[Erdem Akdemir]

Aşağıdaki kodu kullanabilirsiniz.

Sub AAA()

Sayfa1.Range("A3:G1000").ClearContents

Set con = VBA.CreateObject("adodb.Connection")

con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=Yes"""

deg = Sayfa1.Range("B1")

sorgu = "select [SERİ_NO],[MALZEMENİN_ADI],[İL],[İLÇE],[KÖY] ,[MAHALLE] from [VERİ$] where " & deg & " is not null "
Set rs = con.Execute(sorgu)

Range("B3").CopyFromRecordset rs

End Sub

 

[Ahmet Sami]

Sayfa1.Range("A3:G1000").ClearContents

Erdem bey yukarıdaki kodu Sayfa1 yerine isim verdiğimiz sayfanın adını verebilir miyiz. Çünkü başka sayfada aynı kodları uyguladığım zaman hata veriyor aktarma işlemi yapmıyor. Mesela Sayfa1 yerine Sayfa10 da deniyorum Sayfa1 yerine Sayfa10 yazmama rağmen hata veriyor aktarma işlemi yapmıyor.