Kapalı dosyalardan alt alta verileri almak

[1903emre34@gmail.com]

Merhaba,

Kapalı dosyalardan (kayıt 1, kayıt 2) A1:M1 hücrelerin altındaki verileri buraya aktarılması için nasıl kod oluşturabiliriz? (istenen anasayfa 1'de yapılmıştır)

 

[Asri]

VBA ref lerden microsoft script runtime seçili olmalıdır.
Kontrol ediniz.

Dim dosya As String
Dim sh1 As Worksheet

Sub dosyalari_birlestir()
    Dim Folder As Scripting.Folder, Subfolder As Scripting.Folder, File As Scripting.File
    Dim wb As Workbook
    Set sh1 = ActiveWorkbook.Sheets("Sayfa1")
    
    aradizin = ActiveWorkbook.Path
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set Folder = Fso.GetFolder(aradizin)
    i = 0
    For Each File In Folder.Files
      If InStr(File.Name, ".xls") > 0 Then
         dosya = File
         If InStr(UCase(dosya), "ANA SAYFA.XLSX") = 0 Then
            Workbooks.Open (dosya)
            Sheets(1).Range("A2:M" & Sheets(1).UsedRange.Rows.Count).Copy sh1.Cells(sh1.UsedRange.Rows.Count + 1, 1)
            ActiveWorkbook.Close
          End If
      End If
    Next
End Sub

 

[1903emre34@gmail.com]

Teşekkürler, oldu

 

[schlecht]

Merhaba iyi günler, bu kodları anasayfa içinde mi çalıştırmamız gerekiyor. Yoksa anasayfa ve kayıt dosyaları kapalı olacak farklı bir dosyada mı çalıştırmamız gerekiyor.