Bir klasör içindeki dosyalardan 2 sutunun verilerini canlı çekmek

engin.kilic.73 · 7 Ağustos 2025

Merhaba C:\rapor1 klasörünün altında 540 adet dosya oluşuyor.
Dosyanın adları şu şekildedir. Yıl/Ay/Gün/saat/dakikayı ifade edecek şekilde bugün için
202508071000 ile dosyalar başlayıp her dakika buraya 1 dosya kaydedilir.
Birde C:\rapor2 klasörünün içinde adında boş bir dosyam var.

Özet dosyası
a sutunu / b sutunu / c sutunu / d sutunu
ad soyadı / not 1 / 1001 /1002 -->>1800 a kadar gider.

özet dosyasındaki c sutununa 1001 dosyasındaki s sutununu çekmek istiyorum.

Tüm dosyalarda a sutununun satır sayısı aynıdır. ve aynı sıralamada gider.
ornek a1: hakan
a2:veli gibi

e topla ile yapmaya çalıtım fakat güncelleme yapmadı.
Şimdiden teşekkür ederim.

muhasebeciyiz · 8 Ağustos 2025

C:\rapor1 klasöründe her dakika oluşan Excel dosyalarından (adları 202508071000, 202508071001, … 202508081540 gibi) birinden, örneğin "1001" adlı dosyadan "S sütunundaki verileri" alıp,

C:\rapor2\özet.xlsx dosyasının C sütununa yerleştirmek istiyorsunuz.
Tüm bu dosyalarda A sütunundaki ad soyad sıralaması sabit, yani kişi sırası hep aynı.

Kod:

Sub SsutununuOzetDosyasinaAktar()
    Dim kaynakDosyaYolu As String
    Dim hedefDosyaYolu As String
    Dim kaynakKitap As Workbook
    Dim hedefKitap As Workbook
    Dim kaynakSayfa As Worksheet
    Dim hedefSayfa As Worksheet
    Dim i As Long
    Dim veriSayisi As Long

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    kaynakDosyaYolu = "C:\rapor1\1001.xlsx"
    hedefDosyaYolu = "C:\rapor2\özet.xlsx"
    
    Set hedefKitap = Workbooks.Open(hedefDosyaYolu)
    Set hedefSayfa = hedefKitap.Sheets(1) ' gerekirse sayfa adıyla değiştirin
    
    Set kaynakKitap = Workbooks.Open(kaynakDosyaYolu)
    Set kaynakSayfa = kaynakKitap.Sheets(1) ' gerekirse sayfa adıyla değiştirin
    
    veriSayisi = kaynakSayfa.Cells(Rows.Count, "S").End(xlUp).Row
    
    For i = 1 To veriSayisi
        hedefSayfa.Cells(i, "C").Value = kaynakSayfa.Cells(i, "S").Value
    Next i
    
    kaynakKitap.Close SaveChanges:=False
    hedefKitap.Save
    hedefKitap.Close

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

    MsgBox "Veriler başarıyla aktarıldı.", vbInformation
End Sub

Excel’i açın.
ALT + F11 ile VBA editörünü açın.
Insert > Module deyin.
Yukarıdaki kodu yapıştırın.
F5 ile çalıştırın veya Excel'de bir butona bağlayın.

Bu işlem sadece 1001.xlsx dosyasını işler. Eğer farklı dosyalardan (1002, 1003 vs.) veri çekmek isterseniz, döngü kurulabilir

engin.kilic.73 · 8 Ağustos 2025

muhasebeciyiz' Alıntı:
C:\rapor1 klasöründe her dakika oluşan Excel dosyalarından (adları 202508071000, 202508071001, … 202508081540 gibi) birinden, örneğin "1001" adlı dosyadan "S sütunundaki verileri" alıp,

C:\rapor2\özet.xlsx dosyasının C sütununa yerleştirmek istiyorsunuz.
Tüm bu dosyalarda A sütunundaki ad soyad sıralaması sabit, yani kişi sırası hep aynı.

Kod:

Sub SsutununuOzetDosyasinaAktar() Dim kaynakDosyaYolu As String Dim hedefDosyaYolu As String Dim kaynakKitap As Workbook Dim hedefKitap As Workbook Dim kaynakSayfa As Worksheet Dim hedefSayfa As Worksheet Dim i As Long Dim veriSayisi As Long Application.ScreenUpdating = False Application.DisplayAlerts = False kaynakDosyaYolu = "C:\rapor1\1001.xlsx" hedefDosyaYolu = "C:\rapor2\özet.xlsx" Set hedefKitap = Workbooks.Open(hedefDosyaYolu) Set hedefSayfa = hedefKitap.Sheets(1) ' gerekirse sayfa adıyla değiştirin Set kaynakKitap = Workbooks.Open(kaynakDosyaYolu) Set kaynakSayfa = kaynakKitap.Sheets(1) ' gerekirse sayfa adıyla değiştirin veriSayisi = kaynakSayfa.Cells(Rows.Count, "S").End(xlUp).Row For i = 1 To veriSayisi hedefSayfa.Cells(i, "C").Value = kaynakSayfa.Cells(i, "S").Value Next i kaynakKitap.Close SaveChanges:=False hedefKitap.Save hedefKitap.Close Application.ScreenUpdating = True Application.DisplayAlerts = True MsgBox "Veriler başarıyla aktarıldı.", vbInformation End Sub

Excel’i açın.

ALT + F11 ile VBA editörünü açın.

Insert > Module deyin.

Yukarıdaki kodu yapıştırın.

F5 ile çalıştırın veya Excel'de bir butona bağlayın.

Bu işlem sadece 1001.xlsx dosyasını işler. Eğer farklı dosyalardan (1002, 1003 vs.) veri çekmek isterseniz, döngü kurulabilir

Hocam Çok teşekkür ederim. Ayağınıza taş değmesin.

muhasebeciyiz' Alıntı:
C:\rapor1 klasöründe her dakika oluşan Excel dosyalarından (adları 202508071000, 202508071001, … 202508081540 gibi) birinden, örneğin "1001" adlı dosyadan "S sütunundaki verileri" alıp,

C:\rapor2\özet.xlsx dosyasının C sütununa yerleştirmek istiyorsunuz.
Tüm bu dosyalarda A sütunundaki ad soyad sıralaması sabit, yani kişi sırası hep aynı.

Kod:

Sub SsutununuOzetDosyasinaAktar() Dim kaynakDosyaYolu As String Dim hedefDosyaYolu As String Dim kaynakKitap As Workbook Dim hedefKitap As Workbook Dim kaynakSayfa As Worksheet Dim hedefSayfa As Worksheet Dim i As Long Dim veriSayisi As Long Application.ScreenUpdating = False Application.DisplayAlerts = False kaynakDosyaYolu = "C:\rapor1\1001.xlsx" hedefDosyaYolu = "C:\rapor2\özet.xlsx" Set hedefKitap = Workbooks.Open(hedefDosyaYolu) Set hedefSayfa = hedefKitap.Sheets(1) ' gerekirse sayfa adıyla değiştirin Set kaynakKitap = Workbooks.Open(kaynakDosyaYolu) Set kaynakSayfa = kaynakKitap.Sheets(1) ' gerekirse sayfa adıyla değiştirin veriSayisi = kaynakSayfa.Cells(Rows.Count, "S").End(xlUp).Row For i = 1 To veriSayisi hedefSayfa.Cells(i, "C").Value = kaynakSayfa.Cells(i, "S").Value Next i kaynakKitap.Close SaveChanges:=False hedefKitap.Save hedefKitap.Close Application.ScreenUpdating = True Application.DisplayAlerts = True MsgBox "Veriler başarıyla aktarıldı.", vbInformation End Sub

Excel’i açın.

ALT + F11 ile VBA editörünü açın.

Insert > Module deyin.

Yukarıdaki kodu yapıştırın.

F5 ile çalıştırın veya Excel'de bir butona bağlayın.

Bu işlem sadece 1001.xlsx dosyasını işler. Eğer farklı dosyalardan (1002, 1003 vs.) veri çekmek isterseniz, döngü kurulabilir

Hocam çok teşekkür ederim. Ayağınıza taş değmesin.
2 kere denedim çalıştı.
Hocam buna döngü kurabilirmiyiz. 1000-1800 arası veri çeksin diye.
Yalnız buradaki döngüde hocam sırası ile sutunlara gelmesi lazım. 1001 c sutununa 1002 d sutununa --> 1800

-Aşağıdaki kısım eğer zor olacaksa hiç yormayayım hocam sizi.
sayfa 1.e hocam s sutunu sayfa 2 w sutununu çekmek istiyorum

Minnettar kalırım.

muhasebeciyiz · 8 Ağustos 2025

Kod:

Sub TumDosyalardanVeriAktar_Loglu()
    Dim hedefDosyaYolu As String
    Dim hedefKitap As Workbook
    Dim hedefSayfa As Worksheet
    Dim kaynakKitap As Workbook
    Dim kaynakSayfa As Worksheet
    Dim kaynakDosyaYolu As String
    Dim dosyaIndex As Long
    Dim i As Long
    Dim hedefSatir As Long
    Dim sonSatir As Long
    Dim logDosyasi As Integer
    Dim logYolu As String

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    logYolu = "C:\iDeal\Rapor\Log.txt"
    logDosyasi = FreeFile
    Open logYolu For Output As #logDosyasi

    Print #logDosyasi, "Veri Aktarım Logu - " & Format(Now, "yyyy-mm-dd hh:nn:ss")
    Print #logDosyasi, String(50, "-")

    hedefDosyaYolu = "C:\iDeal\Rapor\A3.xlsx"
    Set hedefKitap = Workbooks.Open(hedefDosyaYolu)
    Set hedefSayfa = hedefKitap.Sheets(1)

    hedefSatir = 1

    For dosyaIndex = 1 To 1800
        kaynakDosyaYolu = "C:\iDeal\Rapor\" & Format(dosyaIndex, "0000") & ".xlsx"

        If Dir(kaynakDosyaYolu) = "" Then
            Print #logDosyasi, "❌ Dosya bulunamadı: " & kaynakDosyaYolu
            GoTo SonrakiDosya
        End If

        On Error Resume Next
        Set kaynakKitap = Workbooks.Open(kaynakDosyaYolu)
        If Err.Number <> 0 Then
            Print #logDosyasi, "❌ Dosya açılamadı: " & kaynakDosyaYolu & " | Hata: " & Err.Description
            Err.Clear
            On Error GoTo 0
            GoTo SonrakiDosya
        End If
        On Error GoTo 0

        On Error Resume Next
        Set kaynakSayfa = kaynakKitap.Sheets(CStr(dosyaIndex))
        If kaynakSayfa Is Nothing Then
            Print #logDosyasi, "❌ Sayfa bulunamadı: " & dosyaIndex & " | Dosya: " & kaynakDosyaYolu
            kaynakKitap.Close SaveChanges:=False
            Err.Clear
            On Error GoTo 0
            GoTo SonrakiDosya
        End If
        On Error GoTo 0

        sonSatir = kaynakSayfa.Cells(kaynakSayfa.Rows.Count, "S").End(xlUp).Row

        For i = 1 To sonSatir
            hedefSayfa.Cells(hedefSatir, "C").Value = kaynakSayfa.Cells(i, "S").Value
            hedefSayfa.Cells(hedefSatir, "D").Value = kaynakSayfa.Cells(i, "W").Value
            hedefSatir = hedefSatir + 1
        Next i

        Print #logDosyasi, "✅ Veri aktarıldı: " & kaynakDosyaYolu & " | Satır sayısı: " & sonSatir
        kaynakKitap.Close SaveChanges:=False

SonrakiDosya:
    Next dosyaIndex

    hedefKitap.Save
    hedefKitap.Close

    Close #logDosyasi

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

    MsgBox "✅ Veri aktarımı tamamlandı. Log dosyası oluşturuldu.", vbInformation
End Sub

engin.kilic.73 · 8 Ağustos 2025

muhasebeciyiz' Alıntı:

Kod:

Sub SsutununuOzetDosyasinaAktar()
    Dim kaynakDosyaYolu As String
    Dim hedefDosyaYolu As String
    Dim kaynakKitap As Workbook
    Dim hedefKitap As Workbook
    Dim kaynakSayfa As Worksheet
    Dim hedefSayfa As Worksheet
    Dim i As Long
    Dim hedefSutunIndex As Long

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    kaynakDosyaYolu = "C:\rapor1\1001.xlsx"
    hedefDosyaYolu = "C:\rapor2\özet.xlsx"

    Set hedefKitap = Workbooks.Open(hedefDosyaYolu)
    Set hedefSayfa = hedefKitap.Sheets(1)

    Set kaynakKitap = Workbooks.Open(kaynakDosyaYolu)
    Set kaynakSayfa = kaynakKitap.Sheets(1)
   
    For i = 1000 To 1800
        hedefSutunIndex = i - 1000 + 3
       
        hedefSayfa.Cells(1, hedefSutunIndex).Value = kaynakSayfa.Cells(i, "S").Value
       
        hedefSayfa.Cells(2, hedefSutunIndex).Value = kaynakSayfa.Cells(i, "W").Value
    Next i

    kaynakKitap.Close SaveChanges:=False
    hedefKitap.Save
    hedefKitap.Close

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

    MsgBox "Veriler başarıyla aktarıldı.", vbInformation
End Sub

1000–1800 arası satırları dolaştı
Her bir satırdan S sütununu aldık, hedefte sağa doğru giden sütunlara (C, D, E, ...) yerleşti
Aynı şekilde W sütununu da başka bir satıra yerleştirdi

Dene bakalım

Abi işlem yapmadı hiç. Dosyayı kaydetti. Açtım sutunlarda veri yok

engin.kilic.73 · 8 Ağustos 2025

Sadece S sutununu alsada olur hocam, 1000-->1800 e kadar

muhasebeciyiz · 8 Ağustos 2025

4 mesajı tekrar düzenledim

For i = 1000 To 1800: 1000’den 1800’e kadar olan satırlar işleniyor.
kaynakSayfa.Cells(i, "S").Value: Kaynak dosyada "S" sütunundaki hücreyi alıyor.
hedefSayfa.Cells(hedefSatir, "C").Value: Hedef dosyada "C" sütununa sırayla yazıyor.

1- Dosya yolları doğru mu?
"C:\rapor1\1001.xlsx"
"C:\rapor2\özet.xlsx"
(Gerçekten bu konumda dosyalar var mı?)

2- Sayfa gerçekten ilk sayfa mı?
Sheets(1) doğruysa sorun yok. Aksi durumda açık sayfa adını kullan:
Set kaynakSayfa = kaynakKitap.Sheets("SayfaAdı")

engin.kilic.73 · 8 Ağustos 2025

Hocam yordum sizi, affedin. eksik anlatmışım-yanlış anlaşılmışım.

kaynakDosyaYolu = "C:\iDeal\Rapor\1001.xlsx"
hedefDosyaYolu = "C:\iDeal\Rapor\A3.xlsx"
Yolu buluyor hocam.
Hata yanlış anlaşılmadan dolayı şurada galiba hocam.
kaynakDosyaYolu = (burdaki dosyalar 1001 1002 1003 1004 -->1800 hocam)
bu dosyalardaki her S ve W sutununu
A3dosyasına çekmek istiyorum.

muhasebeciyiz · 8 Ağustos 2025

İsteğiniz ; C:\iDeal\Rapor\ klasöründeki 1001.xlsx'ten 1800.xlsx'e kadar olan tüm Excel dosyalarını açmak
Her bir dosyanın S ve W sütunundaki verileri almak (örneğin: satır 1–1000 arası)
Bu verileri, hedef dosya olan A3.xlsx dosyasına alt alta yazmak
S sütunundaki veriyi A3.xlsx'de C sütununa

W sütunundaki veriyi A3.xlsx'de D sütununa
Alt alta sıralı şekilde yazıyor
Hedef dosya olan A3.xlsx'yi sonunda kaydedip kapatıyor
Eğer sayfa adları özelse, Sheets(1) yerine Sheets("SayfaAdı") kullanmanız gerekebilir.

muhasebeciyiz · 8 Ağustos 2025

4 nolu sayfayı tekrar deneyiniz

engin.kilic.73 · 8 Ağustos 2025

Abi süpersiniz. )) yeminle harika iş benim için. Çok seviyorum bu siteyi.
Umarım yaptığınız iyilik ile ödeşme imkanımız olur.
Üstadım 1001 dosyası geliyor sadece ama diğer dosyalardaki datalar gelmiyor.

bu olmazsa bile sadece şunada razıyım hocam.
hangi dosyadan çekeceğimi ben o satıra yazayım 1001.xlsx i değiştirip 1005.xlsx yapacağım şekilde.

engin.kilic.73 · 8 Ağustos 2025

For dosyaIndex = 1001 To 1800
hocam bu kısmı 1001 i 1005 yapınca sadece 1005 geliyor. bu kısım tamamdır. Ama diğer dosyalar gene gelmiyor

muhasebeciyiz · 8 Ağustos 2025

Dosya yolunun tam doğru olduğundan emin olun. Bu hatalı dosya yolları yüzünden yalnızca bir dosya açılabiliyor olabilir. Örneğin, dosya adında boşluk, büyük/küçük harf farkı veya başka bir yazım hatası olabilir.

Dosya adı formatında herhangi bir farklılık olabilir. Örneğin, 1001.xlsx ile 10001.xlsx gibi bir format farkı söz konusu olabilir. Yani dosya indekslerinin doğru sıralandığından emin olun.

Ayrıca, C:\iDeal\Rapor\ dizininde gerçekten 1002, 1003 vb. dosyaların olduğundan emin olun.

4 nolu dosyayı tekrar deneyiniz

engin.kilic.73 · 8 Ağustos 2025

muhasebeciyiz' Alıntı:
Dosya yolunun tam doğru olduğundan emin olun. Bu hatalı dosya yolları yüzünden yalnızca bir dosya açılabiliyor olabilir. Örneğin, dosya adında boşluk, büyük/küçük harf farkı veya başka bir yazım hatası olabilir.

Dosya adı formatında herhangi bir farklılık olabilir. Örneğin, 1001.xlsx ile 10001.xlsx gibi bir format farkı söz konusu olabilir. Yani dosya indekslerinin doğru sıralandığından emin olun.

Ayrıca, C:\iDeal\Rapor\ dizininde gerçekten 1002, 1003 vb. dosyaların olduğundan emin olun.

4 nolu dosyayı tekrar deneyiniz

Hocam anladım galiba

For dosyaIndex = 1001 To 1800 bu döngüde1001 değiştirdiğim vakit 1005 1006 gibi sadece odosyayı seçiyor.
Bu kadar yorduğum yeterli.
Ayağınıza taş değmesin.

1001 --> 1800 deki sayfa adları aynı değil hocam. muhtemelen ondandır.
1001 dosyasındaki sayfa adı 1001
1058 dosyasındaki sayfa adı 1058
bu yüzden yapmıyor muhtemelen.
Çok teşekkür ederim. Minnettarım.

muhasebeciyiz · 8 Ağustos 2025

Evet, tam olarak doğru tespitte bulunmuşsun: her dosyanın içindeki sayfa adı dosya numarasıyla aynıysa, Sheets(1) ifadesi yerine sayfa adını dosya numarasına göre dinamik olarak seçmen gerekiyor. Şu anda kodun her dosyada ilk sayfayı (Sheets(1)) alıyor ama sayfa adları farklıysa bu hata verir veya yanlış sayfayı okur.

4 nolu mesajı tekrar düzenledim

Sayfa adını dosya numarasına göre dinamik alıyor

Hataları logluyor

Kod daha düzenli ve okunabilir hale getirildi