Tanımlanan sayfadan veri süzme

[cimbom05]

İyi günler,
Bir rapor dosyasının isim sayfası içerisinde A sütununda dosya ismini ve b sütununda bu dosyadan bilgi almak istediğim sayfa isimlerini yazarak Veri sayfasında istediğim aralığı alt alta listeleyebilir miyim? Bununla ilgili bir örnek ekliyorum. Ayrıca bu rapor dosyasının yeri nasıl kolay olabiliyorsa orda olabilir. İlgilenen arkadaşlara teşekkürler.

 

[cimbom05]

İyi akşamlar,
Bu konu ile ilgili bir çalışma olabilir mi?

 

[cimbom05]

İyi günler arkadaşlar
Konu ile ilgili yardımlarınızı bekliyorum.

 

[cimbom05]

Arkadaşlar bu çalışma yapısında istenen makronun uygulanması olanaksız ise çalışma hakkında yönlendirmelerinize açığım. İlk mesajda istediklerimi anlatmıştım. Burada yapılmak istenen belirli bir süreçte hazırlanan raporlardan istatistiki çalışmaların gerçekleşmesidir. Bu amaca ulaşmak için benim uyguladığım yöntem bu şekilde. Eğer sizlerin bu çalışmanın değiştirilmesi ile ilgili önerileriniz olursa değerlendiririz. Bu çalışmaya katılımınızı rica ediyorum. Teşekkürler

 

[janveljan]

Verileri alacağınız dosyalarla rapor dosyanız aynı dizinde olmalı,
Verileri alacağınız dosyadaki sayfalarda verilerin yerleşim şekli standart olmalı ki hata olmasın,
Dosyanız ekte inceleyin lütfen.

Sub aktar()
On Error Resume Next
Application.ScreenUpdating = False
Sheets("veri").Cells.ClearContents
Sheets("veri").Range("A1").Value = "Product"
Sheets("veri").Range("B1").Value = "Criteria"
yol = ActiveWorkbook.Path
For i = 2 To [A65536].End(xlUp).Row
    Set ktp2 = ActiveWorkbook
    Set ktp1 = Workbooks.Open(yol & "\" & ktp2.Sheets("isim").Cells(i, 1))
    sf = ktp2.Sheets("isim").Cells(i, 2)

    ktp1.Sheets(sf).Select
    Range("A6:I" & [I65536].End(xlUp).Row).Copy
    prdct = Range("C2").Value
    
    ktp2.Activate
    Sheets("veri").Select
    satır = [B65536].End(xlUp).Row + 1
    Range("A" & satır).Value = isim
    Range("B" & satır).Select
    ActiveSheet.Paste
    Range("A" & satır & ":A" & [B65536].End(xlUp).Row).Value = prdct
Next
Cells(1, 1).Select
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

 

[cimbom05]

Sayın Janveljan yardımlarınız için teşekkür ederim. Dosyada amaç gerçekleşmiştir.