• DİKKAT

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

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

D

dilekoral

Katılım
14 Haziran 2014
Mesajlar
4
Excel Vers. ve Dili
bilmiyorum
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
 
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
 
aliveli06' Alıntı:
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
Genişletmek için tıkla ...

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
 
Murat OSMA' Alıntı:
Alternatif olarak benim kullandığım dosyayı önerebilirim.
Genişletmek için tıkla ...

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
 
marka212' Alıntı:
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
Genişletmek için tıkla ...
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.
 
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:)
 
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
 

Ekli dosyalar

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
 
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.
 
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
 
Sayın Murat OSMA,
Eklediğiniz dosya boş sayfa açıyor. hiç bir dosyayı birleştirmiyor.
Yardımcı olabilirmisiniz?
 
Kodu kullandım ama üst satırları ve alt satırlardaki hücreleri almıyor. Yardım edermisiniz.
 
aliveli06' Alıntı:
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
Genişletmek için tıkla ...
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' Alıntı:
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.
Genişletmek için tıkla ...
Merhaba,
Bu konuda destek olabilecek kimse var mıdır acaba? Teşekkürler✋
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst