Dosya birleştirme

Barons

Altın Üye
Katılım
14 Mayıs 2005
Mesajlar
967
Excel Vers. ve Dili
Microsoft Ofis 365
Altın Üyelik Bitiş Tarihi
06-01-2040
Merhaba

Sorunum şu: 110 adet excel dosyam var ve bu dosyaların sheet1' lerinde
bilgiler var.Bu 110 adet dosyayı tek bir dosyada ve tek bir sheet'te altalta birleştirmek istiyorum.Acaba böyle bir şey VBA ile mümkünmüdür?

Sütunlar: A-B-C-D (4 adet sütun var)
Satır satıları ise hepsinde farklı.


Ã?rnek olma açısında ilk dosyayı ekde gönderdim.

Teşekkür ve selamlar,

Bu vesile ile geçde olsa Tüm forum üyelerine 2006 yılının huzur ve mutluluk içinde geçmesini dilerim.
 
Katılım
18 Ocak 2006
Mesajlar
1
Yeni bir kitap aç ve açık halde diğer kaydedeceğin kitapları da ve taşıyacağın kitaptaki sheet'lerin sağ klikle taşı veya kopyala modunda üs köşede yeni açtığın yani birleştireceğin kitabın ismini bul işaretle. sheet'lerin bu şekilde teker teker oraya kopyala - yada taşı. ( yani teker teker yapacan ) bildiğim bu.
 

Barons

Altın Üye
Katılım
14 Mayıs 2005
Mesajlar
967
Excel Vers. ve Dili
Microsoft Ofis 365
Altın Üyelik Bitiş Tarihi
06-01-2040
Güzel bir çözüm ancak çok uzun...eminim bu VBA kodu ile yapılabilir.ama nasıl işte mesele o...
 

Levent Menteşoğlu

Administrator
Yönetici
Admin
Katılım
13 Ekim 2004
Mesajlar
16,057
Excel Vers. ve Dili
Excel 2010-32 bit-Türkçe
Excel 365 -32 bit-Türkçe
Dosyalarınızın bulunduğu klasörün yolunu yazarmısınız.
 

Levent Menteşoğlu

Administrator
Yönetici
Admin
Katılım
13 Ekim 2004
Mesajlar
16,057
Excel Vers. ve Dili
Excel 2010-32 bit-Türkçe
Excel 365 -32 bit-Türkçe
Dosyalarınızın "C:\dosyalar" isimli bir klasörde bulunduğunu farz edersek aşağıdaki kodu deneyin. Kodun çalışması uzun sürebilir, görselliği arttırmak için bir progress bar ilavesi ile işlemin durumu takip edilebilir. Bunula ilgili olarakta ekte bir örnek dosya sunuyorum. Aşağıdaki kodun ve ekli dosyanın doğru çalışması için verilerin alınacağı dosyaların mutlaka "C:\dosyalar" klasöründe olması gerekir. Bu yolu kendinize göre değiştirebilirsiniz.

Kod:
Sub aktar()
Application.ScreenUpdating = False
For Each dosya In CreateObject("Scripting.FileSystemObject").GetFolder("c:\dosyalar\").Files
Workbooks.Open Filename:="C:\dosyalar\" & dosya.Name
sonsat = Sheets("sheet1").[b65536].End(3).Row
Rows("1:" & sonsat).Copy
Workbooks("anadosya.xls").Activate
say = [b65536].End(3).Row + 1
Rows(say).PasteSpecial
[a:d].EntireColumn.AutoFit
Workbooks(dosya.Name).Save
Workbooks(dosya.Name).Close
Next
End Sub
 

Barons

Altın Üye
Katılım
14 Mayıs 2005
Mesajlar
967
Excel Vers. ve Dili
Microsoft Ofis 365
Altın Üyelik Bitiş Tarihi
06-01-2040
İŞTE MUHTEŞEM ÇÖZÜM...hızlı ve tam istenilen..yine tam 12'den

Sn LeventM, tekrar tekrar teşekkürlerimi sunar, her zaman mutlu ve huzurlu bir yaşam içinde olmasını can_ı gönülden dilerim.
 

mtl

Katılım
25 Ekim 2005
Mesajlar
63
Sn. leventm yukarıdaki kodu çalıştıramadım. Excel 'im Türkçe olduğu için, sizin kodunuzdaki "sheet1" yerine "sayfa1" yazdım. C de dosyalar isimli bir klasöre excel dosları yerleştirdim ve masaüstümdeki "anadosya" dosyasından kodu çalıştırmak istedim ama,

ProgressBar1.Max = CreateObject("Scripting.FileSystemObject").GetFolder("c:\dosyalar\").Files.Count

satırında hata verdi. Herhalde birşeyler yüklemem gerekiyor. Yardımcı olursanız çok sevinirim.
 
Üst