Birden Çok Kapalı Excel Dosyasından Veri Alma

Katılım
2 Ocak 2009
Mesajlar
11
Excel Vers. ve Dili
excel 2007 türkçe
Arkadaşlar, çalıştığım firmada Cari Hesaplar, ekte göndermiş olduğum dosyadaki gibi klasörlenmiş şekilde tutuluyor. Toplamda yaklaşık 1000 adet müşteri hesabı bulunmakta. Benim yapmak istediğim şey, "Alacak&Verecek Rapor" dosyasına bütün dosyalardan Son Bakiyeyi ve Son Bakiyenin Tarihini (Yani H8 ve I8 hücrelerini) çekebilmek. Bunun kolay bir yolu var mıdır? Ayrıca klasörler içerisine ekleyeceğim veya sileceğim her dosyanın da bu rapora eklenmesi veya silinmesi gerek. Eğer yardımcı olursanız çok sevinirim.
 

Ekli dosyalar

halit3

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
12,798
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
Arkadaşlar, çalıştığım firmada Cari Hesaplar, ekte göndermiş olduğum dosyadaki gibi klasörlenmiş şekilde tutuluyor. Toplamda yaklaşık 1000 adet müşteri hesabı bulunmakta. Benim yapmak istediğim şey, "Alacak&Verecek Rapor" dosyasına bütün dosyalardan Son Bakiyeyi ve Son Bakiyenin Tarihini (Yani H8 ve I8 hücrelerini) çekebilmek. Bunun kolay bir yolu var mıdır? Ayrıca klasörler içerisine ekleyeceğim veya sileceğim her dosyanın da bu rapora eklenmesi veya silinmesi gerek. Eğer yardımcı olursanız çok sevinirim.
1-Bu dosya veri alınacak klasörlerin yanında olmalı
2-veri alınacak dosyaların hepsinde Sayfa1 olmalı ve verilerde bu sayfa1 de olmalı
 

Ekli dosyalar

Katılım
2 Ocak 2009
Mesajlar
11
Excel Vers. ve Dili
excel 2007 türkçe
Üstadım eli koluna sağlık şahane olmuş. tam irdeleyemedim, çok vaktim yoktu, ama beni büyük bir dertten kurtardın teşekkürlerimi sunarım..
 
Katılım
20 Şubat 2008
Mesajlar
23
Excel Vers. ve Dili
ofice 2003
2 farklı excel sayfasından veri alma

2 adet farklı excel dosyasından veri alma konusunda yardımınız rica edeiyroumekli dosyada örneğini yolladım.
 

Ekli dosyalar

Katılım
2 Nisan 2008
Mesajlar
27
Excel Vers. ve Dili
excel 2016 Tr
1-Bu dosya veri alınacak klasörlerin yanında olmalı
2-veri alınacak dosyaların hepsinde Sayfa1 olmalı ve verilerde bu sayfa1 de olmalı

Halit bey dosya oldukça faydalı belirli bir klasörden, belirli bir excel dosyasından veri alırken bu kodu nasıl modifiye edebiliriz acaba?
 

halit3

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
12,798
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
Halit bey dosya oldukça faydalı belirli bir klasörden, belirli bir excel dosyasından veri alırken bu kodu nasıl modifiye edebiliriz acaba?
Klasör için kod:

Kod:
Sub aktar2()
Set Klasor = CreateObject("shell.application").BrowseForFolder(0, "Kaynak Dosyaları İçeren Klasörü Seçin", 50, &H0)
If Not Klasor Is Nothing Then
Kaynak = Klasor.self.Path
If InStr(1, Kaynak, "{") > 0 Then GoTo Atla

Application.DisplayAlerts = False

Range(Cells(2, 1), Cells(Rows.Count, Columns.Count)).Value = ""
For Each Dosya In CreateObject("Scripting.FileSystemObject").GetFolder(Kaynak).Files
If ThisWorkbook.Name <> Dosya.Name Then
deg = "'" & Kaynak & "\" & "[" & Dosya.Name & "]" & "Sayfa1" & "'!R" '//Veri alınacak dosyalardaki sayfa isimi
sat = Cells(Rows.Count, "A").End(3).Row + 1
Cells(sat, 1) = ExecuteExcel4Macro(deg & 2 & "C2")
Cells(sat, 2) = ExecuteExcel4Macro(deg & 8 & "C8")
Cells(sat, 3) = ExecuteExcel4Macro(deg & 8 & "C9")
End If
Next

Application.ScreenUpdating = True
Set Klasor = Nothing
MsgBox "işlem tamam"
Else
Atla:
MsgBox "Lütfen Kaynak Klasör Seçimini Yapınız !", vbInformation, "DİKKAT"
End If
End Sub
dosya için kod:

Kod:
Sub aktar3()

Dim fL As Object
Set fL = CreateObject("Scripting.FileSystemObject")

Kaynak = Application.GetOpenFilename(FileFilter:="Excel Workbooks,*.xls", Title:="Open a File", MultiSelect:=False)
If Kaynak = False Then
MsgBox "Kaynak klasörü seçmediniz"
Exit Sub
End If

Klasor = fL.GetParentFolderName(Kaynak)
Dosya = fL.GetFileName(Kaynak)

Application.DisplayAlerts = False

Range(Cells(2, 1), Cells(Rows.Count, Columns.Count)).Value = ""
deg = "'" & Klasor & "\" & "[" & Dosya & "]" & "Sayfa1" & "'!R" '//Veri alınacak dosyalardaki sayfa isimi
sat = Cells(Rows.Count, "A").End(3).Row + 1
Cells(sat, 1) = ExecuteExcel4Macro(deg & 2 & "C2")
Cells(sat, 2) = ExecuteExcel4Macro(deg & 8 & "C8")
Cells(sat, 3) = ExecuteExcel4Macro(deg & 8 & "C9")
Application.ScreenUpdating = True

MsgBox "işlem tamam"

End Sub
 
Katılım
2 Ocak 2009
Mesajlar
11
Excel Vers. ve Dili
excel 2007 türkçe
Halit Bey bir konuda daha yardıma ihtiyacım var. yardımcı olursanız sevinirim. "Senelik Ciro hesabı" yapmaya çalışıyorum. Ek'te "Cari Hesap Şablonumuzu" gönderdim. Benim yapmayı düşündüğüm şey; başka bir excel dosyasında her firmanın Yıllık toplam satış, toplam ödeme ve toplam ciroyu ayrı ayrı satırlarda belirterek listelemek. Ben bir şablon uydurdum. Ek'te onu da gönderdim. Daha mantıklı bir çözümünüz var ise kabulümdür. Yardımlarınızı bekliyorum.
 

Ekli dosyalar

Katılım
3 Ekim 2013
Mesajlar
39
Excel Vers. ve Dili
Excel 2007 Türkçe
Merhaba,

Mobil aygıttaki bir excel dosyasından kapalıyken veri almak istiyorum. Dosya yolunu bulamıyorum. smartphone olarak görünüyor..dizin oluşturamıyorum sürücü yok:) C:'mi D:'mi H:'mi nasıl bulacağımı da bulamadım..

misal; "C:\users\desktop\vs.xlsx" adresinden sorunsuz veri alabiliyorum..
Mobil aygıt için adresi ne şekilde belirtmeliyim?
 
Katılım
7 Ekim 2013
Mesajlar
169
Excel Vers. ve Dili
2003 TR
Merhabalar Halit Hocam,

7 Nolu mesajınızda Klasör için kod var. Bu kodu klasör seçme yöntemi ile değilde

Kodun içine dosya yolu yazma yöntemi ile kullanmak istiyoruz. Kendimiz düzeltemedik.

Yardımcı olabilir misiniz acaba?
 

halit3

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
12,798
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
Merhabalar Halit Hocam,

7 Nolu mesajınızda Klasör için kod var. Bu kodu klasör seçme yöntemi ile değilde

Kodun içine dosya yolu yazma yöntemi ile kullanmak istiyoruz. Kendimiz düzeltemedik.

Yardımcı olabilir misiniz acaba?
KOD:

Kod:
Sub aktar2()
Kaynak = [COLOR="red"]"C:\DENEME"[/COLOR]

Application.DisplayAlerts = False

Range(Cells(2, 1), Cells(Rows.Count, Columns.Count)).Value = ""
For Each Dosya In CreateObject("Scripting.FileSystemObject").GetFolder(Kaynak).Files
If ThisWorkbook.Name <> Dosya.Name Then
deg = "'" & Kaynak & "\" & "[" & Dosya.Name & "]" & "Sayfa1" & "'!R" '//Veri alınacak dosyalardaki sayfa isimi
sat = Cells(Rows.Count, "A").End(3).Row + 1
Cells(sat, 1) = ExecuteExcel4Macro(deg & 2 & "C2")
Cells(sat, 2) = ExecuteExcel4Macro(deg & 8 & "C8")
Cells(sat, 3) = ExecuteExcel4Macro(deg & 8 & "C9")
End If
Next
Application.ScreenUpdating = True

MsgBox "işlem tamam"

End Sub

Kod:
Sub aktar3()
Kaynak = [COLOR="Red"]"C:\DENEME"[/COLOR]

Dim fL As Object
Set fL = CreateObject("Scripting.FileSystemObject")

Klasor = fL.GetParentFolderName(Kaynak)
Dosya = fL.GetFileName(Kaynak)

Application.DisplayAlerts = False

Range(Cells(2, 1), Cells(Rows.Count, Columns.Count)).Value = ""
deg = "'" & Klasor & "\" & "[" & Dosya & "]" & "Sayfa1" & "'!R" '//Veri alınacak dosyalardaki sayfa isimi
sat = Cells(Rows.Count, "A").End(3).Row + 1
Cells(sat, 1) = ExecuteExcel4Macro(deg & 2 & "C2")
Cells(sat, 2) = ExecuteExcel4Macro(deg & 8 & "C8")
Cells(sat, 3) = ExecuteExcel4Macro(deg & 8 & "C9")
Application.ScreenUpdating = True

MsgBox "işlem tamam"

End Sub
 
Katılım
1 Haziran 2009
Mesajlar
149
Excel Vers. ve Dili
2007
Türkçe
Merhaba
Aynı şekilde A1 ile Z100 arasındaki verileri nasıl çekebiliriz? Yani kodlamada verilerin çekildiği ve aktarıldığı alanı nasıl revize edebiliriz?
 

erdenek

Altın Üye
Katılım
5 Mart 2008
Mesajlar
885
Excel Vers. ve Dili
EV:EXCEL 2010-TÜRKÇE
İŞ:EXCEL 2010-TÜRKÇE
Altın Üyelik Bitiş Tarihi
31-01-2026
arkadaşlar aynı konu olduğu için tekrar konu açmadım.Ekteki dosyayada bir zahmet bakabilirmisiniz.diğer excel dosyasındaki veriler buraya aktıralacak isimli excel dosyasına aktarılacak.dosya boyutu büyük olduğu için birçoğunu çkardım.elimde daha 100-150 arası dosya var.
 

Ekli dosyalar

halit3

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
12,798
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
arkadaşlar aynı konu olduğu için tekrar konu açmadım.Ekteki dosyayada bir zahmet bakabilirmisiniz.diğer excel dosyasındaki veriler buraya aktıralacak isimli excel dosyasına aktarılacak.dosya boyutu büyük olduğu için birçoğunu çkardım.elimde daha 100-150 arası dosya var.
Sorunuzun bu konu ile benzerliği taşımadığını düşünüyorum.
aşağıdaki linkde sorunuzu sormuşsunuz bilenler zaten yardımcı olur diye düşünüyorum.

Size şu öneriyi verebilirim öncelikle dosyanız ofis 2003 de açılmıyor diğer taraftan örnek dosyanızda o kadar çok sayfa var ki sayfalardaki hangi bilgiler alınacak sizin örneğinizde bunlar mevcut değil.

Yukarıda yazdığım sadece öneriydi Kapalı dosyadan veri almak olduk ca zahmetli ve meşekkatli iş.

http://www.excel.web.tr/f14/dioer-excel-dosyalaryndan-veri-alma-t136614.html
 

erdenek

Altın Üye
Katılım
5 Mart 2008
Mesajlar
885
Excel Vers. ve Dili
EV:EXCEL 2010-TÜRKÇE
İŞ:EXCEL 2010-TÜRKÇE
Altın Üyelik Bitiş Tarihi
31-01-2026
ilginize teşekkür ederim.
 
Katılım
20 Eylül 2011
Mesajlar
32
Excel Vers. ve Dili
Office 365 İngilizce
Altın Üyelik Bitiş Tarihi
06-08-2020
Klasör için kod:

Kod:
Sub aktar2()
Set Klasor = CreateObject("shell.application").BrowseForFolder(0, "Kaynak Dosyaları İçeren Klasörü Seçin", 50, &H0)
If Not Klasor Is Nothing Then
Kaynak = Klasor.self.Path
If InStr(1, Kaynak, "{") > 0 Then GoTo Atla

Application.DisplayAlerts = False

Range(Cells(2, 1), Cells(Rows.Count, Columns.Count)).Value = ""
For Each Dosya In CreateObject("Scripting.FileSystemObject").GetFolder(Kaynak).Files
If ThisWorkbook.Name <> Dosya.Name Then
deg = "'" & Kaynak & "\" & "[" & Dosya.Name & "]" & "Sayfa1" & "'!R" '//Veri alınacak dosyalardaki sayfa isimi
sat = Cells(Rows.Count, "A").End(3).Row + 1
Cells(sat, 1) = ExecuteExcel4Macro(deg & 2 & "C2")
Cells(sat, 2) = ExecuteExcel4Macro(deg & 8 & "C8")
Cells(sat, 3) = ExecuteExcel4Macro(deg & 8 & "C9")
End If
Next

Application.ScreenUpdating = True
Set Klasor = Nothing
MsgBox "işlem tamam"
Else
Atla:
MsgBox "Lütfen Kaynak Klasör Seçimini Yapınız !", vbInformation, "DİKKAT"
End If
End Sub
dosya için kod:

Kod:
Sub aktar3()

Dim fL As Object
Set fL = CreateObject("Scripting.FileSystemObject")

Kaynak = Application.GetOpenFilename(FileFilter:="Excel Workbooks,*.xls", Title:="Open a File", MultiSelect:=False)
If Kaynak = False Then
MsgBox "Kaynak klasörü seçmediniz"
Exit Sub
End If

Klasor = fL.GetParentFolderName(Kaynak)
Dosya = fL.GetFileName(Kaynak)

Application.DisplayAlerts = False

Range(Cells(2, 1), Cells(Rows.Count, Columns.Count)).Value = ""
deg = "'" & Klasor & "\" & "[" & Dosya & "]" & "Sayfa1" & "'!R" '//Veri alınacak dosyalardaki sayfa isimi
sat = Cells(Rows.Count, "A").End(3).Row + 1
Cells(sat, 1) = ExecuteExcel4Macro(deg & 2 & "C2")
Cells(sat, 2) = ExecuteExcel4Macro(deg & 8 & "C8")
Cells(sat, 3) = ExecuteExcel4Macro(deg & 8 & "C9")
Application.ScreenUpdating = True

MsgBox "işlem tamam"

End Sub
merhaba,

kodları inceleyip, kendi ihtiyacıma göre editlemeye çalışıyorum
ama kodların içerisinde kayboldum. ".xls" ile biten tüm dosyaların "sayfa1" sekmesinden
B2'yi A kolonuna,
H8'i B kolonuna,
I8'i C kolonuna yazıyor.

bu hücrelerin ismini hiçbir satırda göremedim.
yani ben aşağıdaki gibi yapabilmek için neyi değiştirmeliyim?

birçok .xls dosyasının "sayfa1" sekmesinden aşağıdaki hücreleri alıp, ana dosyama taşımak istiyorum.

A2 - A kolonuna,
A4 - B kolonuna,
A7 - C kolonuna,
A10 - D kolonuna,
A13 - E kolonuna,
A16 - F kolonuna,
A19 - G kolonuna yazmak istiyorum.

bana yardımcı olabilir misiniz?
 
Üst