52 haftalık dosyanın tek sayfada toplanması

[bmk2702bmk]

Merhaba herkese. Elimde 52 haftadan oluşan verilerin bulunduğu bir dosya var. Bu dosyaya bir kapak yapmak istiyorum ve her hafta ilgili haftaya veri girişi yapıldıkça kapak bölümüne o dosyadaki verileri otomatik olarak toplamak istiyorum. Nasıl yapacağımı bilemedim. Bilen sevgili arkadaşlarım ne olur yardım eder miniz.
*ekte dosyanın küçük bir örneğini yaptım.

 

[YUSUF44]

Aşağıdaki makroyu bir modüle kopyalayıp deneyiniz:

Sub kapak()
Set s1 = Sheets("Kapak")
eski = WorksheetFunction.Max(2, s1.Cells(Rows.Count, "A").End(3).Row)
s1.Range("A2:J" & eski).ClearContents
For i = 1 To Sheets.Count
    If Sheets(i).Name <> "Kapak" Then
        yeniB = WorksheetFunction.Max(2, s1.Cells(Rows.Count, "A").End(3).Row + 1)
        Sheets(i).[B4:H30].Copy: s1.Cells(yeniB, "A").PasteSpecial Paste:=xlPasteValues
        yeniH = WorksheetFunction.Max(2, s1.Cells(Rows.Count, "A").End(3).Row + 1)
        Sheets(i).[J4:P30].Copy: s1.Cells(yeniH, "A").PasteSpecial Paste:=xlPasteValues
        son = WorksheetFunction.Max(2, s1.Cells(Rows.Count, "A").End(3).Row)
        s1.Range("H" & yeniB & ":H" & yeniH - 1) = "Bölüm 1"
        s1.Range("H" & yeniH & ":H" & son) = "Bölüm 2"
        s1.Range("I" & yeniB & ":I" & yeniH - 1) = Sheets(i).[H38]
        s1.Range("J" & yeniB & ":J" & yeniH - 1) = Sheets(i).[H39]
        s1.Range("I" & yeniH & ":I" & son) = Sheets(i).[P38]
        s1.Range("J" & yeniH & ":J" & son) = Sheets(i).[P39]
    End If
Next
End Sub

 

[bmk2702bmk]

Çok teşekkür ederim. ellerinize sağlık . birinin cevap vermesi çok mutlu etti beni
minik bir sorunum var.
Test dosyasında çalıştı fakat ana dosyamda çalışmıyor nedeni ise kapak sayfası öncesi bir adet veri sayfası var bundan dolayı çalışmıyor olabilir veri sayfasını kaldırdığımda sorunsuz çalışıyor ama benim veri sayfasına ihtiyacım var. veri sayfası hariç sağa doğru sayfalar için çalıştırabilir miyiz?

 

[YUSUF44]

If Sheets(i).Name <> "Kapak" Then

Satırını

If Sheets(i).Name <> "Kapak" And Sheets(i).Name <> "Veri" Then

Şeklinde değiştirip deneyin.

 

[bmk2702bmk]

harikasınız çalışıyor çok teşekkür ederim ...