Excel sayfalarını nasıl birleştirebilirim

[Ozanoz]

Merhaba;
Excel dosyası içerisinde çok sayıda sayfa var ve bu sayfaların içeriklerini tek sayfada toplamak istiyorum.
Nasıl yapabilirim?
İyi çalışmalar

 

[YUSUF44]

En basit haliyle Kopyala/Yapıştır ile yapabilirsiniz. Aradığınız şey bu değilse sorunuzu örnek dosya ile destekleyip sormanız iyi olur.

 

[Ozanoz]

En basit haliyle Kopyala/Yapıştır ile yapabilirsiniz. Aradığınız şey bu değilse sorunuzu örnek dosya ile destekleyip sormanız iyi olur.

Sayfa sayısı çok fazla. daha önce VBA kodları bulmuştum fakat kaybettim. internetten araştırdığım zaman bulduklarımı da çalıştırmayı başaramadım. link de bir örnek bulabilirsiniz.
https://www.wetransfer.com/download...ea461c4db6acc7575b6809ab20160825074348/1e7767

 

[YUSUF44]

Peki nasıl bir birleştirme yapılacak? Hangi sayfalar hangi sayfada nasıl bir şarta göre birleştirilecek?

 

[Ozanoz]

Peki nasıl bir birleştirme yapılacak? Hangi sayfalar hangi sayfada nasıl bir şarta göre birleştirilecek?

Tüm sayfalar açılacak yeni bir sayfada alt alta gelecek şekilde birleşecek. her ne kadar aralarda özet tablolar olsa da esas datanın kolonları her sayfada aynı hizada. dolayısıyla hepsini tek bir sayfaya alabilirsek basit bir filtreleme ile toplam datayı ayrıştırabilirim.

 

[YUSUF44]

Eğer filtreleme yapmak istiyorsanız filtreleme yapılacak tablonun aralarında boşluk olmadan yerleşmesi gerekmektedir. Dolayısıyla dosyanızda şu anda mevcut olan boş satırlar ve özetler yapacağınız işleme engel olur.

Eğer alttaki özetler önemli değil tüm liste aynı formatta bir sayfada listelensin diyorsanız aşağıdaki kodları bir modüle kopyalayıp deneyiniz. Kodlar verdiğiniz örneğe göre boş bir sayfa ekler. Diğer sayfaları teker teker kontrol edip boş satırları ve başlık satırlarını siler. kalan listeyi yeni eklediği sayfaya kaydeder. A sütununda tarih olmayan tüm satırlar silinir:

Sub Toparla()
    Sheets.Add After:=Sheets(Sheets.Count)
    Sheets(1).Select
    Rows("1:1").Copy Sheets(Sheets.Count).[A1]
    
    For i = 1 To Sheets.Count - 1
        Sheets(i).Select
        Columns("D:D").Select
        Selection.Replace What:="Arac", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        Range("D1") = "Arac"
        Columns("D:D").Select
        Selection.SpecialCells(xlCellTypeBlanks).Select
        Selection.EntireRow.Delete
        Rows("2:2").Select
        Range(Selection, Selection.End(xlDown)).Select
        yeni = Sheets(Sheets.Count).Cells(Rows.Count, "A").End(3).Row + 1
        Selection.Copy Sheets(Sheets.Count).Cells(yeni, "A")
    Next
    
    Sheets(Sheets.Count).Select
    For j = 2 To Cells(Rows.Count, "A").End(3).Row
        If IsDate(Cells(j, "A")) = False Then Rows(j).Delete
    Next
End Sub

 

[Ozanoz]

Eğer filtreleme yapmak istiyorsanız filtreleme yapılacak tablonun aralarında boşluk olmadan yerleşmesi gerekmektedir. Dolayısıyla dosyanızda şu anda mevcut olan boş satırlar ve özetler yapacağınız işleme engel olur.

Eğer alttaki özetler önemli değil tüm liste aynı formatta bir sayfada listelensin diyorsanız aşağıdaki kodları bir modüle kopyalayıp deneyiniz. Kodlar verdiğiniz örneğe göre boş bir sayfa ekler. Diğer sayfaları teker teker kontrol edip boş satırları ve başlık satırlarını siler. kalan listeyi yeni eklediği sayfaya kaydeder. A sütununda tarih olmayan tüm satırlar silinir:

Sub Toparla()
    Sheets.Add After:=Sheets(Sheets.Count)
    Sheets(1).Select
    Rows("1:1").Copy Sheets(Sheets.Count).[A1]
    
    For i = 1 To Sheets.Count - 1
        Sheets(i).Select
        Columns("D:D").Select
        Selection.Replace What:="Arac", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        Range("D1") = "Arac"
        Columns("D:D").Select
        Selection.SpecialCells(xlCellTypeBlanks).Select
        Selection.EntireRow.Delete
        Rows("2:2").Select
        Range(Selection, Selection.End(xlDown)).Select
        yeni = Sheets(Sheets.Count).Cells(Rows.Count, "A").End(3).Row + 1
        Selection.Copy Sheets(Sheets.Count).Cells(yeni, "A")
    Next
    
    Sheets(Sheets.Count).Select
    For j = 2 To Cells(Rows.Count, "A").End(3).Row
        If IsDate(Cells(j, "A")) = False Then Rows(j).Delete
    Next
End Sub

denedim fakat aşağıdaki hata çıktı

Run-time error '1004':
Application-defined or object-defined error

 

[Ozanoz]

tamamdır;
çalıştı... çok teşekkür ederim.
ellerinize sağlık...