Ayrı excel dosyalarındaki bilgileri tek sayfada toplamak

[Ã?zgür]

Merhabalar,

Ã?ncelikle böyle bir paylaşım ortamı yaratılmasına katkıda bulunan herkese teşekkür ederim.

Benim problemim şu şekilde; tek bir klasör altında bulunan yaklaşık 200 adet excel dosyasının her birinin L2:L40 hücreleri arasındaki bilgileri yeni bir excel dosyasının bir sayfasında sütun halinde birleştirmem gerekiyor. Bu işlemi dosyaları tek tek açmadan makro ile gerçekleştirmem mümkün mü?

 

[Levent Menteşoğlu]

Aşağıdaki kodu kendinize göre uyarlayın. Buraca C:\excel klasörü altındaki tüm dosyaların sayfa1 L2:L40 arasındaki verileri alt alta A sütununa yazacaktır. Yalnız şuna dikkat edin klasör içinde sadece excel dosyaları bulunmalıdır.

Sub verial()
Dim ds, dc, f, s
Set ds = CreateObject("Scripting.FileSystemObject")
Set f = ds.GetFolder("C:\excel")
Set dc = f.Files
For Each dosya In dc
For a = 2 To 40
c = c + 1
Cells(c, 1) = ExecuteExcel4Macro("'C:\excel\[" & dosya.Name & "]sayfa1'!R" & a & "C12")
Next: Next
End Sub

 

[ALPEN]

Way bu da süpermis.

ExecuteExcel4Macro

 

[Levent Menteşoğlu]

Kapalı dosyadan veri çekilmesinde ExecuteExcel4Macro gerçekten çok kullanışlı bir yöntem.

 

[tamer42]

Merhabalar,
Gerçekten faydalı bir uygulama!

"C:\Text" klasörü altındaki tüm text dosyaların (*.txt) içeriğini bir excel sheet'inde toplamak için kod üzerinde nasıl bir değişiklik yapmak gerekir.

İyi Çalışmalar dilerim.

 

[Levent Menteşoğlu]

Bunun için sanırım en kolay yol Excelin dış veri al özelliğini kullanmaktadır. Aşağıdaki kod bu özelliği kullanarak text dosyasındaki verileri almaktadır. Konunun dahada detaylandırılması için alternatif çözüm sunan arkadaşlarımızda olursa bende çok memnun olurum.

Sub verial()
Dim ds, dc, f, s
Set ds = CreateObject("Scripting.FileSystemObject")
Set f = ds.GetFolder("C:\Text")
Set dc = f.Files
For Each dosya In dc
c = c + 1
ActiveSheet.QueryTables.Add(Connection:="TEXT;C:\Text\" & dosya.Name, Destination:=Cells(c, 1)).Refresh
Next
End Sub

 

[aligunes]

verileri almak

arkadaşlar c klasörü altında 65 tane excel dosyam var ve bunların A1:A500,B1:B500,C1:C500,D1500,E1:E500 ü bir sayfada nasıl alabilirim şimdiden ilginize teşekkür ederim. Cevabınız biraz çabuk olursa sevinirim saygılar.

arkadaşlar inanın bu makro acele lazım cevap bekliyorum

 

[aligunes]

Buraca C:\excel klasörü altındaki tüm dosyaların sayfa1 L2:L40 arasındaki verileri alt alta A sütununa yazıyor

visual basic kodu:
--------------------------------------------------------------------------------
Sub verial()
Dim ds, dc, f, s
Set ds = CreateObject("Scripting.FileSystemObject")
Set f = ds.GetFolder("C:\excel")
Set dc = f.Files
For Each dosya In dc
For a = 2 To 40
c = c + 1
Cells(c, 1) = ExecuteExcel4Macro("'C:\excel\[" & dosya.Name & "]sayfa1'!R" & a & "C12")
Next: Next
End Sub

arkadaşlar c klasörü altında 65 tane excel dosyam var ve bunların A1:A500,B1:B500,C1:C500,D1500,E1:E500 ü bir sayfada nasıl alabilirim şimdiden ilginize teşekkür ederim. Cevabınız biraz çabuk olursa sevinirim saygılar.

arkadaşlar inanın bu makro acele lazım cevap bekliyorum

sayın Moderatörler lütfen

 

[Levent Menteşoğlu]

Öncelikle C altında excel isimli bir klasör oluşturun ve tüm dosyalarınızı bu klasör altına kopyalayın. Sonrada aşağıdaki kodu bir dosyada çalıştırın. Fakat dosya sayısının ve çekilecek veri aralığının fazla olması işlem süresini çok uzatabilir.

Sub verial()
Dim ds, dc, f, s
Set ds = CreateObject("Scripting.FileSystemObject")
Set f = ds.GetFolder("C:\excel")
Set dc = f.Files
For Each dosya In dc
For b=1 to 5
For a = 2 To 40
c = c + 1
Cells(c, b) = ExecuteExcel4Macro("'C:\excel\[" & dosya.Name & "]sayfa1'!R" & a & "C" & b)
Next
c=0
Next
Next
End Sub

Not:kodu deneme şansım olmadı.

 

[aligunes]

sayın Leventm

vermiş olduğunuz kod stunda sadece belirtilen degere kadar yazıyor 40 satıra kadar yani alt alta toplama yapmıyor 40 ı 500 yaptım bu defada bir sayfadaki değerleri alıyor ve 500 e tamamlamak için diğerlerini 0 yazıyor

 

[Levent Menteşoğlu]

Kodu düzelterek yeniden vereceğim.

 

[aligunes]

bekliyorum teşekkür ederim

 

[Levent Menteşoğlu]

Aşağıdaki şekilde deneyin.

Sub verial()
Dim ds, dc, f, s
Set ds = CreateObject("Scripting.FileSystemObject")
Set f = ds.GetFolder("C:\excel")
Set dc = f.Files
For Each dosya In dc
For a = 1 To 500
For b = 1 To 5
deger = ExecuteExcel4Macro("'C:\excel\[" & dosya.Name & "]sayfa1'!R" & a & "C" & b)
If deger = 0 Then GoTo 10
Cells(c + 1, b) = deger
Next
c = c + 1
Next
10 Next
End Sub

 

[aligunes]

sayın leventm kod hata veriyor.

 

[Levent Menteşoğlu]

Deneyerek gönderdim, hiç hata vermedi. Klasör altında excel dışında başka dosya olmasın. Birde klasör adı ile sayfa ismine dikkat edin. Sayfa1 olacak.

 

[aligunes]

sayın leventm kod hata veriyor.ayrıca biraz önce belirttiğim 500 e kadar olan
A ve E arası sutunlar belirtilen excel dosyalarından sadece birini yazıp devamını 0 la tamamlamış birde verial komutunu çalıştırınca tüm dosyaları okuyor fakat son okudugu sayfayı yazıyor

 

[Levent Menteşoğlu]

Bir yerde hata yapıyorsunuz, ekteki dosyayı açın ve kitap1 ve kitap2 yi excel isimli klasörün altına anadosya isimli dosyayıda farklı bir klasöre kopyalayın. Sonra anadosyayı açarak sayfa1 deki butona basın.

 

[Asri]

Dim sayfaadi, ilkkolonadi, sonkolonadi As String

Sub kayitoku()
   
   sonsatir = Sheets(sayfaadi).Range(ilkkolonadi + "65536").End(xlUp).Row
   kolon = ilkkolonadi + "1:" & sonkolonadi & sonsatir
   Range(kolon).Select
   Selection.Copy
   Windows("dosya_birlestir.xls").Activate
   
   sonsatir = Sheets("liste").Range(ilkkolonadi + "65536").End(xlUp).Row

   sec = ilkkolonadi & sonsatir + 1
   Range(sec).Select
   ActiveSheet.Paste

End Sub


Sub anamenu()
Dim ds, dc, f, s

'Tanımlamalar
sayfaadi = "Sayfa1"
dosyadizini = "c:\excel\"
ilkkolonadi = "L"
sonkolonadi = "M"

Set ds = CreateObject("Scripting.FileSystemObject")
Set f = ds.GetFolder(dosyadizini)
Set dc = f.Files
For Each dosya In dc
  dosyaadi = dosya.Name
  If Right(dosyaadi, 3) = "xls" Then
     dosya = dosyadizini + dosyaadi
     Workbooks.Open dosya
     Application.DisplayAlerts = False
     Call kayitoku
     Workbooks(Dir(dosya)).Close
     Application.DisplayAlerts = True
     Windows(1).Activate
  End If
Next
 
End Sub

Bu da benden olsun. Aslında ilk mesaj yazıldığında yazmıştım ama o kısa kodu görünce göndermekten vazgeçtim. Þimdi o koddan alıntı yaparak (Ben dosya isimleri excel e aktarıp yapmıştım Parametrik ve block copy yöntemi ile yaparak gönderiyorum.

 

[Ã?zgür]

Sayın leventm ve asri,

Cevaplarınız için çok teşekkür ederim...

 

[yayalar]

bizim sorunlarımıza bır cozum bulunamayacak sanırsam 2 gündür beklıyorum ama halen bır cevap yok...beklemeye devam