Kapalı dosyalar üzerinden veri erişim döngüsü

[awesper]

Üstadlar kolay gelsin,

Böyle bir kaynağı bize sunduğunuz için çok teşekkür ederim.Sayenizde çok şey öğrendim, öğreniyorum.Sözü uzatmadan soruma geçmek istiyorum.Formülle yapılamadığını öğrendiğim için makrolar altında başlığı açtım.Öncelikle forumda epey araştırma yaptığımı bilmenizi isterim kapalı dosya uygulamalarına epey baktım ancak sorunumu çözemedim, döngü konusunu çok yapamadığım için yazma ihtiyacı hissediyorum.
Şöyleki;

Ekli abc,def,ghı dosyaları örnek data dosyalarıdır.Sonuçlar sayfasında siteden öğrendiğim bir makroyu entegre ettim b1,c1,d1..... şeklinde itibaren belirtilen klasör içindeki tüm dosyaları ad olarak yazıyor.

İstediğim şey şu,öyle bir makro hazırlayalım ki ben diğer makro ile dosya isimlerini en üst satıra listeledikten sonra bu makro abc.xlsx dosyasından data 1 e karşılık gelen değeri yazsın, bunu data 36 ya kadar devam ettirsin.Sonra def.xlsx dosyasından dataları yerine yazsın taki üst satırdaki dosya adları bitene kadar.Anlayabildiğim kadarıyla 2 ayrı döngü makrosu olacak, bu sayede belirttiğim klasördeki kapalı tüm xlsx dosyalarından tek makro ile arama yaparak veri alabileceğim, ilginiz için çok teşekkür ederim.

 

[Huseyinkis]

Ekli kodları denermisiniz. Sonuçlar dosyasının A1 sütununa klasörün yerini yazmanız gerekiyor.

Örnek C:\Users\Huseyin\Desktop\AAAA

Sub huso()
    Dim Yol As String, Dosya As String
    Dim K2 As Workbook
    On Error GoTo son:
    
For u = 2 To Cells(1, Columns.Count).End(1).Column
Dosya = Cells(1, u).Value
    Yol = Cells(1, 1) & "\"
Set K2 = Workbooks.Open(Yol & Dosya, False, False)
Windows(Dosya).Activate
Range("B3:B38").Copy
Windows("Sonuçlar.xlsx").Activate
Cells(3, u).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Application.CutCopyMode = False
    K2.Close True
    
Next u
son:
End Sub

 

[awesper]

Üstadım Merhaba,

Bütün dosyalar masaüstünde sonuçlar klasörününün içinde dediğiniz gibi dosya yolunu a1 hücresine yazdığımda herhangi bir kopyalama gerçekleşmeden sadece abc dosyasında copy komutunun aktif kenarlıklı şekli (çizgi çizgi hareket eden şekil) yer almakta.Ben makroyu sonuçlar dosyasının sheet 1'ne yapıştırarak run diyorum acaba sorun bundan mı kaynaklanıyor?

Az önce makro modülü olarak tekrar denedim.Makro çalışınca abc.xls dosyası açılıyor ve kopyalama pozisyonunda bekliyor.Dosya yolu C:\Documents and Settings\75389\Desktop\Sonuçlar şeklinde olup ilk dosya adı b1 hücresinden başlayarak yazılması gerekmelidir.

Sub Dosya_İsimleri()
[1:1].ClearContents
'[b:b].ClearContents
Set klasor = CreateObject("Shell.Application").BrowseForFolder(0, "Lütfen dosyaları listelenecek klasörü seçin !", &H100)
yol = klasor.Items.Item.Path
If yol = "" Then Exit Sub
Set nesne = CreateObject("Scripting.FileSystemObject")
Set dosyalar = nesne.GetFolder(yol)
Set liste = dosyalar.Files
For Each dosya In liste
c = c + 1
Cells(1, c + 1) = dosya.Name
'Cells(c + 1, 2) = dosya.Path
Next
End Sub


üstadlarımın da yardımıyla makrosunu örnek alarak kullanarak dosya isim yada yolunu hücrelere sırayla yazdırabilmekteyim.Bundan sonrasını yapamıyorum.Üst satırdaki dosyaları tek tek bulup ilgili hücreleri bulması yada aynı sıralama olduğundan kopyalaması gerekmektedir.
Teşekkür ederim.

 

[awesper]

Sayın Hüseyinkis verdiğiniz makroda uğraşarak sorunumu hallettim.Çok teşekkür ederim.