Soru Çoklu Dosyalardaki Belli Hücrelerden Veri Çekme

teknoman

Altın Üye
Katılım
29 Nisan 2017
Mesajlar
66
Excel Vers. ve Dili
Office 365
Altın Üyelik Bitiş Tarihi
28-09-2027
Merhabalar,bir klasör içerisinde günlük olarak tuttuğumuz satış raporu dosyalarımız mevcuttur.Bu dosyalarımız çok fazla sayıda olduğundan belli hücrelerdeki değerleri bir dosyada toplamamız gerekiyor.Her dosyada tekbir RAPOR adında sayfa mevcuttur. Yapmak istediğimiz B sutununa klasör içindeki dosya isimlerini yazdırıp bu dosyalar içinde sayfa isimleri aynı olan ve belirlenen hücrelerdeki verileri çekmemiz.Böyle bir raporlama örneğini makro ile yapmamız mümkün müdür? Yardımlarınız için şimdiden teşekkür ederim.
örnekrapor.jpg
 

Ekli dosyalar

teknoman

Altın Üye
Katılım
29 Nisan 2017
Mesajlar
66
Excel Vers. ve Dili
Office 365
Altın Üyelik Bitiş Tarihi
28-09-2027
Çoklu veri almada tüm dosyalardan ayni hücre değerini çeken makro kodu olmalı kanımca
 

teknoman

Altın Üye
Katılım
29 Nisan 2017
Mesajlar
66
Excel Vers. ve Dili
Office 365
Altın Üyelik Bitiş Tarihi
28-09-2027
Değerli hocalarım yardımlarınızı bekliyorum.İyi çalışmalar dilerim.
 

teknoman

Altın Üye
Katılım
29 Nisan 2017
Mesajlar
66
Excel Vers. ve Dili
Office 365
Altın Üyelik Bitiş Tarihi
28-09-2027
Değerli hocalarım bana da yardım edebilir misiniz
 

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
Diğer 4 dosyayıda koyarsanız deneme yapmak için lazım olacaktır.:cool:
 

teknoman

Altın Üye
Katılım
29 Nisan 2017
Mesajlar
66
Excel Vers. ve Dili
Office 365
Altın Üyelik Bitiş Tarihi
28-09-2027
Değerli Orion1 hocam o klasördeki 4 dosyayı örnek olarak gösterdim.Klasör içerisinde çok fazla sayıda dosyalar mevcut.Benim öğrenmek istediğim klasör içerisinde ne kadar dosya varsa her dosya içerisinden istenen hücre içeriklerini çeken bir kod.Örneğin SATIŞLAR isminde bir klasörümüz ve bu klasör içinde bulunan tüm dosyalardaki C1 hücresini yazdıralım.Bu konuda yardımcı olabilirmisiniz.Saygılar hocam
 

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
Değerli Orion1 hocam o klasördeki 4 dosyayı örnek olarak gösterdim.Klasör içerisinde çok fazla sayıda dosyalar mevcut.Benim öğrenmek istediğim klasör içerisinde ne kadar dosya varsa her dosya içerisinden istenen hücre içeriklerini çeken bir kod.Örneğin SATIŞLAR isminde bir klasörümüz ve bu klasör içinde bulunan tüm dosyalardaki C1 hücresini yazdıralım.Bu konuda yardımcı olabilirmisiniz.Saygılar hocam
Olabilşr.Şimdilik siz 2-3 dosya ekleyin.Yoksa benmi hazırlayım.
Biz afaki yazmıyoz kodları.
Dosyaların üzerinde çalışıp.En son doğru kodları bulup yazıyoz kodları.
Onun için dosya lazım.
Siz şimdilik 2-3 dosya yapın ben onu göz önünde tutacam.:cool:
 

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
Dosya ekle derken , asıl dosyalarınızı eklemeyin.Örnek bir dosya ekleyin.Uyduruk veriler koyun.:cool:
 

teknoman

Altın Üye
Katılım
29 Nisan 2017
Mesajlar
66
Excel Vers. ve Dili
Office 365
Altın Üyelik Bitiş Tarihi
28-09-2027
Peki hocam örnek dosyalarımı size gönderiyorum.Her dosyadaki E14 hücresindeki değeri dosya ismi ile birlikte yazdırabilirmiyiz
 

Ekli dosyalar

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,307
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
İlk eklediğiniz dosyayı son eklediğiniz klasör içine alın. Aşağıdaki kodları son eklediğiniz dosyaya ekleyip makro içeren dosya formatında kayıt edin ve kodu çalıştırın.

Kod:
Option Explicit

Sub Dosyalardan_Verileri_Aktar()
    Dim K1 As Workbook, S1 As Worksheet, K2 As Workbook
    Dim Dosya As String, Yol As String, Satir As Long
  
    Application.ScreenUpdating = False
  
    Set K1 = ThisWorkbook
    Set S1 = K1.Sheets("Sayfa1")
  
    Yol = K1.Path & "\"
  
    S1.Range("B6:H" & Rows.Count).ClearContents
    Satir = 6
  
    Dosya = Dir(Yol & "*.*")
  
    While Dosya <> ""
        If Dosya <> "ÖrnekRapor1.xlsm" Then
            Set K2 = Workbooks.Open(Yol & Dosya, 0, 0)
            S1.Cells(Satir, 2) = K2.Name
            S1.Cells(Satir, 3) = K2.Sheets(1).Name
            S1.Cells(Satir, 4) = K2.Sheets(1).Range("F6")
            S1.Cells(Satir, 5) = K2.Sheets(1).Range("G8")
            S1.Cells(Satir, 6) = K2.Sheets(1).Range("G12")
            S1.Cells(Satir, 7) = K2.Sheets(1).Range("H15")
            S1.Cells(Satir, 8) = K2.Sheets(1).Range("K8")
            Satir = Satir + 1
            K2.Close 0
        End If
        Dosya = Dir
    Wend

    Application.ScreenUpdating = True
  
    MsgBox "Veri aktarımı tamamlanmıştır.", vbInformation
End Sub
 

teknoman

Altın Üye
Katılım
29 Nisan 2017
Mesajlar
66
Excel Vers. ve Dili
Office 365
Altın Üyelik Bitiş Tarihi
28-09-2027
Korhan hocam çok teşekkür ederim.
K2.Name ve K2.Sheets(1).Name aynı sütuna denk gelmiş onuda düzelttim sorun kalmadı.İyi çalışmalar hocam.Ellerinize sağlık
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,307
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Kopyala-yapıştırın azizliği olmuş. Bende mesajımı düzenledim.
 
Üst