birden fazla excel.xls dosyasını birleştirme

[dilekoral]

birden fazla excel.xls dosyasını bir excel dosyasında birleştirmek istiyorum araştırdım denedim yapamadım kodlarla ilgili hiçbir bilgimde yoktur nasıl yapılır toparlanır ve elimde 900 ü aşkın excel.xls dosyası bulunmaktadır.

yardımcı olursanız sevinirim...

saygılar
dilek

 

[aliveli06]

masaüstüne yeni klasör açıp tüm excel dosyalarınızı buraya kopyalayın daha sonra aynı yere yeni bir excel dosyası açıp alt+f11 yapın gelen pencerede -insert- daha sonra -module- tıklayıp açılan yere aşağıdaki kodları kopyalayıp yapıştırın ve F5 e basın.

Sub HepsiniBirleştir()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
yol = ThisWorkbook.Path
ad = ThisWorkbook.Name
ayrac = Application.PathSeparator
dosya = Dir(yol & ayrac & "*.xlsx")
Do While dosya <> ""
If dosya <> ad Then
Workbooks.Open yol & ayrac & dosya
Dim sayfa As Worksheet
For Each sayfa In Workbooks(dosya).Worksheets
sadi = sayfa.Name
Workbooks(ad).Activate
Workbooks(ad).Sheets.Add After:=Sheets(Sheets.Count)
Workbooks(dosya).Worksheets(sadi).Range("A:Z").Copy
Workbooks(ad).Sheets(Sheets.Count).Paste
Next
Workbooks(dosya).Close
End If
dosya = Dir()
Loop
Application.ScreenUpdating = False
Application.DisplayAlerts = True
End Sub

 

[Murat OSMA]

Alternatif olarak benim kullandığım dosyayı önerebilirim.

 

[marka212]

masaüstüne yeni klasör açıp tüm excel dosyalarınızı buraya kopyalayın daha sonra aynı yere yeni bir excel dosyası açıp alt+f11 yapın gelen pencerede -insert- daha sonra -module- tıklayıp açılan yere aşağıdaki kodları kopyalayıp yapıştırın ve F5 e basın.

Sub HepsiniBirleştir()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
yol = ThisWorkbook.Path
ad = ThisWorkbook.Name
ayrac = Application.PathSeparator
dosya = Dir(yol & ayrac & "*.xlsx")
Do While dosya <> ""
If dosya <> ad Then
Workbooks.Open yol & ayrac & dosya
Dim sayfa As Worksheet
For Each sayfa In Workbooks(dosya).Worksheets
sadi = sayfa.Name
Workbooks(ad).Activate
Workbooks(ad).Sheets.Add After:=Sheets(Sheets.Count)
Workbooks(dosya).Worksheets(sadi).Range("A:Z").Copy
Workbooks(ad).Sheets(Sheets.Count).Paste
Next
Workbooks(dosya).Close
End If
dosya = Dir()
Loop
Application.ScreenUpdating = False
Application.DisplayAlerts = True
End Sub

tesekkurler aliveli dediginiz gibi yapıyorum modulu giriyorum f5 'e tıkladıktan sonra run a tıklıyoyorum ama dosya yolundamı bir hata var anlamadım olmuyor

 

[marka212]

Alternatif olarak benim kullandığım dosyayı önerebilirim.

murat bey tesekkurler yardımlarınız için ama excel dosyasında sayfa sayfa olusturdugu için benim pek işime yaramıyor bu altalta toplaması gerekli ornekteki fatura kesim gibi bende onu fatura programına gonderiyorum cunku tşk

 

[dilekoral]

eror uyarısı veriyor nedendir acaba

 

[Murat OSMA]

murat bey tesekkurler yardımlarınız için ama excel dosyasında sayfa sayfa olusturdugu için benim pek işime yaramıyor bu altalta toplaması gerekli ornekteki fatura kesim gibi bende onu fatura programına gonderiyorum cunku tşk

Konuyu açan siz değilsiniz, aynı konu ile ilgili yardım istediğiniz de görünmüyor. Bu yüzden size yanıt vermedim, Sn. dilekoral'a yanıt verdim.

Eğer aynı konuda yardım istiyorsanız bunu belirtin ki bilelim.
Şu an bakıldığında marka212 ile dilekoral aynı kişi görünüyor.

Öyle mi ?

Şayet öyleyse; kurallara aykırı bir durum söz konusudur ve sizin siteden uzaklaştırılmanız gerekir.

 

[marka212]

merhaba ben dun gece yeni konu acmıstım ama bende acaba cevap gelmişmi diye baktıgımda konu sahibi ben degilmişim gibi gozukuyor sabah bu sekilde degilki diger arkadas ile benim bir alakam yoktur belki mod arkadaslar aynı konu diye birleştirmiş olabilir veya db ile alakalı birsey olabilirki pek ihtimal vermiyorum konu benim actıgım konudur murat bey

 

[marka212]

bir hatadan dolayı tekrardan acmaya gerek yok yeni konu sanırım bu konu altındanda bana yardımcı olabilcekler var ise sevinirim dosya ektedir ornek dosyada gunluk excel dosyaları vardır istedigim aynı klasorde bulunan fatura kesim dosyasında bunların hepsinin toplanmasıdır ben manuel olarak fatura kesim dosyasına klasorde bulunanları ekledim bunun otomatik olmasını istiyorum eger mumkun ise şimdiden tşk

 

[ZorBey_]

http://www.excel.web.tr/f50/toplu-veri-cekme-excel-yardym-t141518.html

 

[dilekoral]

merhaba marka 212 ben degilim adım ile kayıt açmış bulunmaktayım yetkililerde ip den tesbir edebilirler farklı oldugunu bir isim kullanmak varken neden 2 isim kullanayım

bu arada konuyuda ben açtım

 

[Murat OSMA]

Konuyu sizin açtığınız görünüyor evet. Sn. marka212 sanırım hatları karıştırmış.

Konu ile ilgili olarak birkaç örnek dosya ile ana dosyanızı eklerseniz yardımcı olmaya çalışırım.

 

[marka212]

üzgünüm hatlar karışmış

 

[Murat OSMA]

Fark ettik.

İyi günler.

 

[dilekoral]

ornek dosya ekleyemiyorum bide dosya indiremiyorum üyeliğim yeni olduğu için galiba ben kısaca şöyle özetliyim
1760 adet excel.xls dosyası var ve her dosyada 100 satıra yakın bilgi var hepsi bir excel dosyasına sıgmıyor o yüzden kabul etmedi galiba formül

 

[Murat OSMA]

Konu ile ilgili olarak birkaç örnek dosya ile ana dosyanızı eklerseniz yardımcı olmaya çalışırım.

Siteye dosya yüklemek ve dosya indirmek için Altın Üye olmanız gerekmektedir.
Detaylı bilgi için bakabilirsiniz; http://www.excel.web.tr/f53/altyn-yelik-t57910.html

Google'a dosya upload yazın, listelenen herhangi bir siteye dosyalarınızı yükleyin ve mesaja yapıştırın.

 

[feridici_genc]

Sayın Murat OSMA,
Eklediğiniz dosya boş sayfa açıyor. hiç bir dosyayı birleştirmiyor.
Yardımcı olabilirmisiniz?

 

[trteam]

Kodu kullandım ama üst satırları ve alt satırlardaki hücreleri almıyor. Yardım edermisiniz.

 

[*Freeman]

masaüstüne yeni klasör açıp tüm excel dosyalarınızı buraya kopyalayın daha sonra aynı yere yeni bir excel dosyası açıp alt+f11 yapın gelen pencerede -insert- daha sonra -module- tıklayıp açılan yere aşağıdaki kodları kopyalayıp yapıştırın ve F5 e basın.

Sub HepsiniBirleştir()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
yol = ThisWorkbook.Path
ad = ThisWorkbook.Name
ayrac = Application.PathSeparator
dosya = Dir(yol & ayrac & "*.xlsx")
Do While dosya <> ""
If dosya <> ad Then
Workbooks.Open yol & ayrac & dosya
Dim sayfa As Worksheet
For Each sayfa In Workbooks(dosya).Worksheets
sadi = sayfa.Name
Workbooks(ad).Activate
Workbooks(ad).Sheets.Add After:=Sheets(Sheets.Count)
Workbooks(dosya).Worksheets(sadi).Range("A:Z").Copy
Workbooks(ad).Sheets(Sheets.Count).Paste
Next
Workbooks(dosya).Close
End If
dosya = Dir()
Loop
Application.ScreenUpdating = False
Application.DisplayAlerts = True
End Sub

Merhaba, kod çok güzel bir şekilde çalışmaktadır. Elinize sağlık. Benim sorum şu şekilde; wxcel dosyalarındaki sheetleri birleştiriyor ancak sheetlerin isimlerini almıyor. Sheetleri mevcut dosyanın içerisindeki ismini de aktarması sağlanabilri mi?
teşekkürler iyi çalışmalar.

 

[*Freeman]

Merhaba, kod çok güzel bir şekilde çalışmaktadır. Elinize sağlık. Benim sorum şu şekilde; wxcel dosyalarındaki sheetleri birleştiriyor ancak sheetlerin isimlerini almıyor. Sheetleri mevcut dosyanın içerisindeki ismini de aktarması sağlanabilri mi?
teşekkürler iyi çalışmalar.

Merhaba,
Bu konuda destek olabilecek kimse var mıdır acaba? Teşekkürler