Birden Çok Sayfayı Tek Sayfada Birleştirme

[tatasoy]

Örnek dosyada da gösterildigi üzere 85 sayfadan oluşan (örnekte 3 sayfa) excel dosyasındaki bilgiler tek sayfa içerisinde nasıl toplanabilir. Yeni oluşturulacak sayfada bilgiler sayfa sırasıyla olmalıdır

 

[Necdet]

Merhaba,

Ekli dosyayı inceleyiniz.

Public Sub BirArayaGetir()
Set s1 = Sheets("Hepsi")
Application.ScreenUpdating = False
On Error Resume Next
s1.Rows("5:65536").Delete
For i = 2 To Sheets.Count
    Sheets(i).Activate
    SonSatır = s1.[A65536].End(3).Row + 1
    BasSatır = 0
    BasSatır = Columns("A:A").Find("KOD").Row
    If BasSatır > 0 Then
       BasSatır = BasSatır + 1
       SonSat = [B65536].End(3).Row
       Range("A" & BasSatır & ":E" & SonSat).Copy s1.Range("A" & SonSatır)
    End If
Next i
s1.Select
MsgBox Sheets.Count - 1 & " Adet Sayfa Birleştirildi...."
End Sub

 

[tatasoy]

Teşekkür ederim. Çok güzel olmuş.

Fakat başlık satırlarını da "Hepsi" sayfasına aktaramaz mıyız.

Sayfa sonundaki 1 adet boş satırdan sonraki boş satırları "Hepsi" sayfasına aktarmamak için nasıl bir işlem yapılmalı. Hatta sayfa sonlarındaki sayfa numaraları bile aktarmaya gerek yoktur.

Yardımlarınız için tekrar teşekkür ederim.

 

[Necdet]

Merhaba,

Aşağıdaki kodları dener misiniz?

Beğenmezseniz değiştirme şansımız var

Public Sub BirArayaGetir()
Set s1 = Sheets("Hepsi")
Application.ScreenUpdating = False
On Error Resume Next
s1.Range("A1:E65536").Clear
For i = 2 To Sheets.Count
    Sheets(i).Activate
    SonSatır = s1.[A65536].End(3).Row + 2
    SonSat = [B65536].End(3).Row
    Range("A1:E" & SonSat).Copy s1.Range("A" & SonSatır)
Next i
s1.Select
MsgBox Sheets.Count - 1 & " Adet Sayfa Birleştirildi...."
End Sub

 

[tatasoy]

Çok güzel oldu.

Bu makro "Hepsi" adlı sayfa olması halinde çalışmakta.Gönderilen herhangi bir excel listesinde de uygulanabilmesi için macro "hepsi" sayfası kendisi yaratabilir mi?

Yardımlar için çok teşekkürler....

 

[Necdet]

Merhaba,

Aşağıdaki kodları deneyiniz.

Public Sub BirArayaGetir()
If Sheets(1).Name <> "Hepsi" Then
    Sheets.Add Before:=Sheets(1)
    ActiveSheet.Name = "Hepsi"
End If
Set s1 = Sheets("Hepsi")
s1.Select
Application.ScreenUpdating = False
On Error Resume Next
s1.Range("A1:E65536").Clear
For i = 2 To Sheets.Count
    Sheets(i).Activate
    SonSatır = s1.[A65536].End(3).Row + 2
    SonSat = [B65536].End(3).Row
    Range("A1:E" & SonSat).Copy s1.Range("A" & SonSatır)
Next i
s1.Select
MsgBox Sheets.Count - 1 & " Adet Sayfa Birleştirildi...."
End Sub

 

[tatasoy]

Tekrar tekrar teşekkürler..

 

[tatasoy]

aşagıdaki adresteki soruna da bir bakamilir misiniz.


http://www.excel.web.tr/showthread.php?p=221570#post221570

 

[baydeniro]

Paylaşım İçin Teşekkürler

Sayın Necdet_Yersetener paylaşım için çok teşekkürler. Çok yararlı bir çalışma. Sağlıcakla kalın.