Makro ile birden fazla sayfayı birleştirme

[cedi007]

Selamlar,

Örnek olarak belirtmiş olduğum dosyadaki birden fazla sayfayı "Data" adında yeni bir sayfada alt alta toplamak istiyorum. Bunun makro ile çalışır bir yöntemi veya kodu var mıdır, desteğinizi rica ediyorum.

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub Consolidate_All_Sheets()
    Dim Sayfa As Worksheet, S1 As Worksheet
    
    On Error Resume Next
    Application.DisplayAlerts = False
    Sheets("DATA").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
    
    Set S1 = Sheets.Add(, Sheets(Sheets.Count))
    S1.Name = "DATA"
    
    For Each Sayfa In ThisWorkbook.Worksheets
        If Sayfa.Name <> "DATA" Then
            If S1.Range("A1") = "" Then Sayfa.Range("A1:DB1").Copy S1.Range("A1")
            Sayfa.Range("A2:DB" & Sayfa.Cells(Sayfa.Rows.Count, 1).End(3).Row).Copy S1.Cells(S1.Rows.Count, 1).End(3)(2, 1)
        End If
    Next

    S1.Columns.AutoFit

    Set S1 = Nothing
    
    MsgBox "Sayfalar konsolide edilmiştir.", vbInformation
End Sub

 

[metin_0606]

Selamlar,

Örnek olarak belirtmiş olduğum dosyadaki birden fazla sayfayı "Data" adında yeni bir sayfada alt alta toplamak istiyorum. Bunun makro ile çalışır bir yöntemi veya kodu var mıdır, desteğinizi rica ediyorum.

Deneyiniz

 

[cedi007]

@korhan bey'in iletisindeki normalde 4 sayfadan oluşan datayı 4 ten büyük olan farklı bir dosyada denedim sonuç mükemmel. Hiçbir sıkıntı olmadı.
@metin bey sizin de kodunuzu denedim o da çok sağlıklı. 4 sayfadan fazla olduğundan durum ne olurdu denemedim açıkçası. Çok teşekkür ediyorum.

 

[selimekeroglu]

teşekkürler