ExcelVBA.Net sitesine katkıda bulunabilirsiniz

[ali288]

Merhaba,

Farklı excel doslarından, belirli bir sayfa adından ve aralığından (A4:F74) veri almaya çalışıyorum.

Yardımcı olursanız sevinirim

[erseldemirel2]

Kod açıklamalı olarak aşağıdadır. Deneyiniz. D:\Test yolunda ne kadar xls varsa açar; TİZ1 sayfası ilgili alandan veri çekip alt alta ekler

Kod: Tümünü seç

Sub VerileriCek()
    Dim wbHedef As Workbook
    Dim wsHedef As Worksheet
    Dim dosyaYolu As String
    Dim dosyaAdi As String
    Dim hedefSatir As Long
    Dim veriAlan As Range
    Dim dosya As String
   
    ' Kaynak ve hedef dosyaları belirtin
    Set wbHedef = ThisWorkbook ' Tumveri isimli Excel dosyası
    Set wsHedef = wbHedef.Worksheets("Sheet1") ' Hedef sayfa
   
    ' Kaynak dosyalarının klasör yolunu belirtin
    dosyaYolu = "D:\veri\"
   
    ' Klasördeki tüm dosyaları döngü ile işleyin
    dosya = Dir(dosyaYolu & "*.xls")
    hedefSatir = 1

    Do While dosya <> ""
        ' Kaynak dosyayı açın
        Workbooks.Open (dosyaYolu & dosya)
       
     
        ' TİZ1 sayfasını bulun
        Dim wsKaynak As Worksheet
        For Each wsKaynak In ActiveWorkbook.Worksheets
            If wsKaynak.Name = "TİZ1" Then
                Exit For
            End If
        Next wsKaynak
       
        ' TİZ1 sayfası bulunduysa veri alanını belirleyin ve kopyalayın
        If Not wsKaynak Is Nothing Then
            Set veriAlan = wsKaynak.Range("A4:F74")
            veriAlan.Copy wsHedef.Cells(hedefSatir, 1)
            hedefSatir = hedefSatir + veriAlan.Rows.Count
        End If
       
        ' Kaynak dosyayı kapatın
        ActiveWorkbook.Close SaveChanges:=False
       
        ' Bir sonraki dosyayı alın
        dosya = Dir()
    Loop
   
    ' Uyarı mesajını gösterin
    MsgBox "Veriler başarıyla çekildi.", vbInformation
End Sub



[ali288]

Sayın Ersel,

Kod çalışıyor.

Çok teşekkür ederim.

[erseldemirel2]

Rica ederim kolay gelsin