sayfaların özeti bağ yapıştır

[ozpoli]

bir excel kitabındaki birden cok sayfadaki dolu olan hücreleri yeni bir sayfada hepsini alt alta birleştirerek tek sayfaya yapıştırma bu bağ yapıştırda deger olarakta olabılır mesela sayfa 1 a1 den z100 kadar dolu aynı şekilde sayfa 2 sayfa 3 de aynı bunları yeni bir sayfada a1 den z300 kadar olacak sekilde yapıstırıp tek liste yapacak sayfa isimleri farklıda olabilmeli sayfa 1 2 diye gitmeyebilir

 

[Ömer]

Merhaba,

Option Explicit
Sub Ozet()
Dim S1 As Worksheet
Dim sat, i As Long
Dim Sayfa As Worksheet
Set S1 = Sheets("ana sayfa")
Application.ScreenUpdating = False
S1.Select
Range("A2:E65536").ClearContents
sat = 1
    For Each Sayfa In Worksheets
        If Sayfa.Name <> "ana sayfa" Then
            For i = 2 To Sayfa.[A65536].End(3).Row
                If Sayfa.Cells(i, "a") <> "" Then
                    sat = sat + 1
                    Range("A" & sat & ":D" & sat).Value = Sayfa. _
                    Range("A" & i & ":D" & i).Value
                    [COLOR=red]Cells(sat, "e") = Sayfa.Name[/COLOR]
                End If
            Next i
        End If
    Next Sayfa
Set S1 = Nothing
Application.ScreenUpdating = True
MsgBox "Aktarım Tamamlanmıştır.", vbInformation, "[URL="http://www.excel.web.tr/"]www.excel.web.tr[/URL]"
End Sub

Bu şekilde deneyin.

Kırmızı satır gelen verilerin sayfa adlarını e sütununa listeler. Bunu kontrol amaçlı eklemiştim. Gereksiz ise bu satırı silersiniz.

.

 

[ozpoli]

emeğinize sağlık süper olmuş