• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Klasördeki tüm excel dosyalarının belirli hücre aralıklarını bir dosyada kopyalama

C

CENGAVER1

Katılım
27 Eylül 2010
Mesajlar
21
Excel Vers. ve Dili
Professional Plus 2010
Merhaba sayın üstatlar,

Benim için zor, sizin için ise çok kolay olacağını düşündüğüm bir soru.
Farklı konularda benzer sorular mevcut, ancak bu soru bulduğum 2 ayrı makronun birleşimi olduğu için yapamadım
Bir klasördeki tüm excel dosyalarının belirli bir aralığının (mesela A1-H24) alt alta bir dosyaya kopyalamasına ihtiyacım var.
Bu hücre aralığını makro başlamadan sorarak alırsa daha fonksiyonel olabilir.
Bu konu hakkındaki değerli yardımlarınızı arz ederim.

Saygılarımla
 
Merhaba,

Excel' ler kaç sayfadan oluşuyor.
Excel dosyalarının sayfa isimleri aynı mı?
 
Son düzenleme:
Dosya isimleri sayfa1 ve verileri çekeceğiniz excel dosyası aynı klasörde olması şartı ile aşağıdaki kodu kullanabilirsiniz.
Diğer şartlara göre kod revize edilebilir.

Kod: 
Sub getir()

    Set con = VBA.CreateObject("adodb.Connection")
   Set cat = CreateObject("ADOX.Catalog")

'Set klasor = CreateObject("Shell.Application").BrowseForFolder(0, "Lütfen bir klasor seçin !", 1)
    Cells.ClearContents

    Dim bir As Object
    Set bir = CreateObject("scripting.filesystemobject")
    yol = ThisWorkbook.Path
    Set klasor = bir.getfolder(yol)
    For Each dosyalar In klasor.Files
    If Not dosyalar.Name Like "*xlsm*" Then
    If dosyalar.Name Like "*xls*" Then

con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
yol & "\" & dosyalar.Name & ";extended properties=""Excel 12.0;hdr=yes"""

cat.ActiveConnection = con
syf = Replace(cat.tables.Item(0).Name, "'", "")

sorgu = "select * from[" & syf & "A1:H20]"
Set rs = con.Execute(sorgu)
son = Cells(Rows.Count, "a").End(3).Row + 1
Range("A" & son).CopyFromRecordset rs
con.Close
        End If
        End If
    Next
End Sub
 
Son düzenleme:
Erdem bey,
yazdığınız kod çalışıyor ancak kitlenme yaşadığım için sadece bi kaç sorum olacak
1-xlsx olmayan dosyalarda sorun olur mu, klasörde xlsx ve xls olan dosyalar var
2-sayfa adları aynı tüm dosyalarda, ancak arada boşluk var nasıl düzetlmem gerekir "xxx xxx" şeklinde mi yoksa "xxx_xxx" gibi mi?
3-klasördeki tüm dosyalar dediğimizde çalıştığımız dosyaya da işlem yapmıyor mu?
Yardımlarınız için şimdiden teşekkür ederim
 
Merhaba,

Kodu güncelledim. xls ve xlsx uzantılı dosyalardaki verileri alacak. Sayda isimlerinde boşluk olması önemli değil.
 
Erdem bey, kod harika hiçbir sorun yok,
bir sorum daha olsa zahmet olur mu acaba,
bundan sonra gelecek dosyalarda sayfa ismi şartını kaldırabilir miyiz?
mesela her dosyanın ilk sayfası yapabilir miyiz kodu?
yoksa illa bi isim gerekir mi?
 
Merhaba,

Kodu güncelledim. Excel dosyalarının ilk sayfasını alacak.
 
İlave bilgi:

Erdem Beyin ADO kullanımına alternatif olarak eğer DAO kullansaydık, kapalı dosyanın ilk sayfasından veri almak için "TableDefs" özelliğini kullanabilirdik...

Kod: 
            Set DB = daoDBEngine.OpenDatabase(myFile, False, False, "Excel 8.0; HDR=Yes; IMEX=1;")
            myTable = DB.TableDefs(0).Name
            Set RS = DB.OpenRecordset("Select * from [" & myTable & "A1:H20]")
 
Haluk bey,size de cevabınız için çok teşekkürler, farklı dosya tiplerinde çalışmak istersek DAO da işimize yarayabilir.

Erdem bey bu sefer böyle bir hata verdi, bir önceki kod gayet güzel çalışırken
https://ibb.co/mbkQxv6

farklı farklı dosyalarla denedim, hangisinin ilk sayfa adı neyse öyle hatada o dosya adını bulamadığını söyledi nedense.
hataya gittiğimde
Set rs = con.Execute(sorgu) satırını refere ediyor
 
Merhaba,

Örnek dosyanızda sayfa adını alırken tek tırnak ekliyor.

Kodun aşağıdaki kısmını değiştirin. Mevcut kodu'da güncelledim.

Kod: 
syf = Replace(cat.tables.Item(0).Name, "'", "")
 
Erdem bey kusura bakmayın bugün dönüş yapamadım,
pazartesi işyerinde ilk iş test edip dönüş yapacağım
iyi haftasonları dilerim
 
Erdem bey, elinize sağlık çok teşekkür ederim.
kod çok güzel çalışıyor.
Ben size bi jest yapmak istesem mümkün mü acaba?
 
Cengaver bey,

Teşekkür etmeniz yeterli.

İyi çalışmalar.
 
Erdem Hocam belki konu kapanmıştır ama yine de teşekkür ederim bu vermiş olduğun kod çok güzel günlerdir uğraştığım kitaplar arası veri aktarmayı bununla çözdüm. Allah razı olsun
 
Üstadım Tek Sayfa lı kitaplarda problem yok ama çalışma kitabında sayfa 1 sayfa 2 sayfa 3 gibi sayfalar olduğun da kod SAYFA2 den veri çekiyor bunu sadece sayfa birden çekecek şekilde nasıl düzenleriz? yardımcı olabilir misin?
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst