Birden fazla excel dosyası BİRLEŞTİRMEK

[ipkisiyamaksosis]

Slm arkadaşlar, :yardim:

Çok özür dileyerekten bir maruzatım olacak forumu gerçekten aradım taradım fakat bulamadım.

Elimde sütunları aynı satır sayıları birbirinden farklı 100 e yakın xls dosyası var benim bunları alt alta tek bir excel dosyasında birleştirmem gerekiyor ancak ben bu işlemi her ay yapıyorum ve yaklaşık 1,5 2 saatimi alıyor ve iğrenç birşey forumda bu konu ile ilgili hiçbirşey bulamadım. :???:

İstedğim şey ise bir user form ile seçeceğim dosyaların alt alt birleştirilmesidir.

Ne olur yardımcı olun. Allah razı olsun.

 

[Necdet]

Merhaba,

Dosyalar hangi dizinde bulunuyor? Makro açısından bunu bilmekte yarar var.

Birleştirilecek en az iki dosyayı örnek olarak ekleseniz sorunuz belki çoktan çözümlenmiş olurdu.

Artık gerisini siz düşünün

 

[ipkisiyamaksosis]

Kusura bakmayın düşünemedim.

C:/BIRLESTIR klasörünün altında örnek olarak ekteki dosyaları kullanabilirsiniz.

İlginiz için Teşekkürler...

 

[Necdet]

Sayın ipkisiyamaksosis ,


Siz yanıtı verene kadar ben programı tamamladım

Ekteki dosyalardan Deneme1.xls ve Deneme2.xls yi c:\deneme adlı klasörün altına koyunuz. Diğer DOSYA_BIRLESTIR.XLS dosyasını ise istediğiniz dizin içine koyabilirsiniz.

Çalıştıracağınız dosya DOSYA_BIRLESTIR.xls dir.

İki buton vardır. Dosya Getir Butonuna basarsanız C:\DENEME dizinindeki dosyaları birinci sayfaya getirir.

Siz bunları inceleyip aktarılmaması gereken dosyaları B sütununa herhangi bir işaret koymalısınız.

Sonra Durumu Boş Olanları Aktar Butonu ile dosyaları 2. sayfada birleştirir.

 

[ipkisiyamaksosis]

Çok ama çok teşekkür ederim. Süpersiniz. Gerçekten ellerinize sağlık inanılmaz güzel olmuş tam istediğim gibi.

Bir sormak istediğim birşey daha var.

Macro dosyaları birleştirmek için açıyor ya kopyaladıktan sonra açılan dosyayı kapatabilir miyim? Macro ile tabi.

100 e yakın dosya olduğu için durumu boş olanları aktar butonuna tıkladığımda pc şişiyor

 

[Necdet]

Dosyaları kapat diyorum ama küçük dosyalarda bellek yettiği için kapatmıyor olabilir, tam emin değilim, yada ben kapattığımı sanıyorum.

Bu durum doğru ise bende yardım bekliyorum.

 

[Korhan Ayhan]

Selamlar,

Sn. Necdet beyin kodlarındaki aşağıdaki satırı bir sonraki ile değiştirirseniz açılan dosyalar işlem bittikten sonra otomatik olarak kapatılır.

Değişecek kod;

Workbooks(Dosya_Ad).Close False

Olması gereken kod;

[color=red]Workbooks(Dosya_Ad1).Close True[/color]

 

[Necdet]

Tam yanıt verecekken, Sayın COST_CONTROL yanıtlamış.

Bende

Workbooks(Dosya_Ad1).Close False

Diyecektim.

Dosyayı tekrar ekliyorum.

 

[ipkisiyamaksosis]

Herkese teşekkürler.

Sayın Necdet bey,

Sizden dün cevap gelmeyince ben Workbooks(Dosya_Ad1).Close True yaptım ve oldu ancak şimdi başka bir sorunum var bu 100'e yakın dosya kapanırken save edeyim mi diye soruyor ve ben 100 defa Hayır'a tıklamak zorunda kalıyorum. Bunu nasıl engelleyeceğimi çözemedim.

Cevabınızı bekliyorum.

Herkese tekrar sonsuz teşekkürler tabi Necdet bey size de ellerinize sağlık.

 

[Necdet]

Sayın ipkisiyamaksosis,

8. Mesajdaki dosyayı indirdiniz mi?, Ben onu çalıştırdığımda bana sormuyor.

Aktar Makrosu Şöyle Olmalı

Public Sub Aktar()
Application.ScreenUpdating = False
On Error Resume Next
Adet = [A65536].End(3).Row
Satir_Sayisi = 1
Sheets(2).[A2:C65536].ClearContents
For i = 2 To [A65536].End(3).Row
If Cells(i, "B") = "" Then
Dosya_Ad = Cells(i, "A")
Dosya_Ad1 = Right(Dosya_Ad, InStr(StrReverse(Dosya_Ad), "\") - 1)
Workbooks.Open (Dosya_Ad)
 
' ------------ aktarma burda ---------------------
Sheets(1).Select
 
Satir_Sayisi = [B65536].End(3).Row
 
Range("A2:C" & Satir_Sayisi).Select
 
Selection.Copy
 
Windows("DOSYA_BIRLESTIR.xls").Activate
Sheets(2).Select
Satir_Sayisi = [B65536].End(3).Row + 1
 
 
Range("A" & Satir_Sayisi).Select
ActiveSheet.Paste
Windows(Dosya_Ad1).Activate
Workbooks(Dosya_Ad1).Close [B][COLOR=red]False[/COLOR][/B]
Windows("DOSYA_BIRLESTIR.xls").Activate
Sheets(1).Select
End If
Next i
End Sub

 

[ipkisiyamaksosis]

Yine aynı şeyi yapıyor, sizin gönderdiğiniz macroyu tamamen kopyaladım.

Ekte karşıma çıkan uyarıyı bulabilirsiniz? Ben her defasında No diyorum.

Teşekkürler...

 

[AS3434]

Konuya bende karışayım..

Dosyayı indirip denemedim ama
Kodlara Mavi satırı ilave edip denermisiniz.

Public Sub Aktar()
Application.ScreenUpdating = False
[COLOR=navy]Application.DisplayAlerts = False[/COLOR]
.
.
.

 

[ipkisiyamaksosis]

Sayın AS3434,

Çok teşekkür ederim. Ellerinize sağlık. Tam istediğim gibi oldu.

Cevap veren herkese sonsuz teşekkürler...

 

[AS3434]

Ben birşey yapmadım ki..!!
Yemeği Sayın Yesertener pişirdi, ben sadece , "Ocaktan aldım servis yaptım."

Geri dönüşümünüz için ben de size teşekkür ederim.

 

[Necdet]

Evet küçük datalarda sesini çıkartmıyordu, ordan atlamışım Sayın AS3434'ün eklediği DisplayAlert fonksiyonunu.

Artık sanırım düzgün çalışır, sizde rahat edersiniz Sayın ipkisiyamaksosis.

 

[esuhan]

Bu hakikaten çok kullanışlı. Ancak benim birleştirdiğim dosyaların R sütununa kadar genişlemesi gerekiyor. Bu makroda sadece 3 adet sütunu birleştirebiliyorum. Yardımcı olur musunuz?

 

[Necdet]

Merhaba,

Yukarıdaki kodlardaki

Range("A2:C" & Satir_Sayisi).Select
satırını aşağıdaki gibi değiştiriniz.

Range("A2:R & Satir_Sayisi).Select

 

[conan_1905]

selamlar,
dosyaların silinmesiyle ilgili yazıyı okudum. gerçekten çok üzüldüm. böylesi geniş içeriğe sahip bir forumun database kaybına uğramasının ne olduğunu bir forum yöneticisi olarak iyi bilirim(
sizden isteğim; bu başlıktaki adı geçen dosyayı bilgisayarında bulunduran varsa tekrar yükleyebilir mi? başlık altında bir sürü koddan bahsedilmiş ama tek bir satırından hiçbir şey anlamadım özür dilerim.
dosya birleştirmek benim her hafta yaptığım bir iş hem de yüzlerce dosyayla.
bu dosya elinde olan varsa ve yükleyebilirse çok sevinirim. şimdiden uğraşan herkese teşekkür ederim...

 

[mustafakoker]

selamlar,
dosyaların silinmesiyle ilgili yazıyı okudum. gerçekten çok üzüldüm.
sizden isteğim; bu başlıktaki adı geçen dosyayı bilgisayarında bulunduran varsa tekrar yükleyebilir mi? .
şimdiden uğraşan herkese teşekkür ederim

 

[bsarta]

selamlar,
dosyaların silinmesi için gerçekten çok üzüldüm.
konuyu başından sonuna kadar okudum fakat örnek olması açısından konudaki dosyalara sahip olan varsa ve tekrar yüklerse sevinirim. Teşekkür ederim.