Veri Aktarimi

[latinov]

Merhabalar.

"c:\veri" klasoru icerisinde tüm .xls dosyalarinin ayni hücrelerinden("B21", "C23", "F23", "C25",......) verileri alıp "data.xls" dosyasına

sicil ad soyad dtar dyer ....
----------------------------------------------------------
001 xxxxxx xxxxx 01/01/2000 xxxxxx
002
003
.
.
.
600

seklinde alt alta listeleyen bir macro yazmaya çalistim. Fakat basarili olamadim.
Yardimci olabilecek arkadaslara simdiden tesekkurler


Excel dosyaları..:
c:\veri\1.xls
c:\veri\2.xls
.
.
.
.
c:\veri\600.xls

 

[Levent Menteşoğlu]

Aşağıdaki kodu "data" isimli kitabınızda çalıştırın. Yalnız "c:\veri" klasöründeki dosyalardan veri alınacak sayfa adını vermemişsiniz. Aşağıdaki kodda bu sayfa adı "sayfa1" kabul edilmiştir. Kendinize göre değiştirin.

Sub verial()
For Each dosya In CreateObject("Scripting.FileSystemObject").GetFolder("C:\veri").Files
c = c + 1
Cells(c, 1) = ExecuteExcel4Macro("'C:\veri\[" & dosya.Name & "]sayfa1'!R21C2")
Cells(c, 2) = ExecuteExcel4Macro("'C:\veri\[" & dosya.Name & "]sayfa1'!R23C3")
Cells(c, 3) = ExecuteExcel4Macro("'C:\veri\[" & dosya.Name & "]sayfa1'!R23C6")
Cells(c, 4) = ExecuteExcel4Macro("'C:\veri\[" & dosya.Name & "]sayfa1'!R25C3")
Next
End Sub

 

[latinov]

Tam istedigim gibi olmus bu kadar kolay olabilecegini dusunememistim

Çok Teşekür ederim Sn. leventm..
:hey:
:mutlu:

 

[latinov]

Tekrar çok tesekürler Sn. leventm;

Bir sorum daha olacak..

"C:\Veri" klasoru altindaki dosyalar sifreli diyelim. Ve tum dosyalarin sifreleri ayni.
Burada sifre tanimlamasini nasi yapacağim.

Cells(c, 1) = ExecuteExcel4Macro("'C:\veri\[" & dosya.Name & "]sayfa1'!R6C6", Password:="abcd"

diye bir ekleme yaptim fakat basarili olamadim..

Ilginize simdiden tesekkurler..

 

[Levent Menteşoğlu]

Bu durumda aşağıdaki iki kod önereceğim. Tercih sizin.

Sub verial()
Application.ScreenUpdating = False
ad = ActiveWorkbook.Name
For Each dosya In CreateObject("Scripting.FileSystemObject").GetFolder("C:\veri").Files
c = c + 1
Workbooks.Open Filename:="C:\veri\" & dosya.Name, Password:="abcd", WriteResPassword:="abcd"
Workbooks(ad).Activate
Cells(c, 1) = Workbooks(dosya.Name).Sheets("sayfa1").[b21]
Cells(c, 2) = Workbooks(dosya.Name).Sheets("sayfa1").[c23]
Cells(c, 3) =Workbooks(dosya.Name).Sheets("sayfa1").[f23]
Cells(c, 4) = Workbooks(dosya.Name).Sheets("sayfa1").[c25]
Workbooks(dosya.Name).Close
Next
End Sub

2.önerim (Sn Haluk beyin önerisi doğrultusunda)

Sub verial()
Set MyXL = CreateObject("Excel.Application")
For Each dosya In CreateObject("Scripting.FileSystemObject").GetFolder("C:\veri").Files
c = c + 1
Set MyWB = MyXL.Workbooks.Open("C:\veri\" & dosya.Name, Password:="abcd", WriteResPassword:="abcd")
Cells(c, 1) = MyWB.Sheets("sayfa1").[b21]
Cells(c, 2) = MyWB.Sheets("sayfa1").[c23]
Cells(c, 3) = MyWB.Sheets("sayfa1").[f23]
Cells(c, 4) = MyWB.Sheets("sayfa1").[c25]
MyWB.Close
Next
MyXL.Quit
End Sub

 

[NoiR_DeSiRe]

Sn Levent

Çalışmanız eminim çok başarılıdır ancak benim gibi bir amatör için herhangi basit bir makro uygulaması bile gayet zor oluyor...

Aslında sorunum şu; elimde 300 kadar txt dosyası var ve bunları bir excel sayfasında copy paste şeklinde toplamak saatlerimi alıyor.İşin kötü yanı hata yapma olasılığım yüksek.

Benim sormak istediğim bir kaç değişiklik hakkında.

1. veri alınacak excel yerine txt dosya olabilir mi...?
2. eğer olamıyorsa veri alınacak sheet ismi çalışma sayfası ile aynı ise ne tür bir kod değişikliği olmalı?

İyi Çalışmalar....