3 farklı sayfayı özet tablo ile birleştirmek??

[erkan1907]

Herkese merhaba, daha önce özet tablo ile sayısal olan 4 farklı sayfayı birleştirebilmiştim, fakat bu seferki sorunum verilerin sayısal olmayışı.
Özet tablo ile denedim fakat bi çözüm elde edemedim. 3 yıla ait cari kodlar ve adresleri bir sayfada toplamak istiyorum. Ekteki örnekte yıllar da yazan kodları Toplam sayfasında birleştirmesini istiyorum.

teşekkür ederim.

 

[Korhan Ayhan]

2003 versiyonda olmuyor sanırım. Yeni versiyonlarda veri etiketleri görünüyordu diye hatırlıyorum. Şu an deneme yapamıyorum.

İsterseniz makro ile veriler birleştirilebilir.

 

[erkan1907]

sizden makroyuda rica etsem çokmu olurum?? makro bilgim sıfırdır çünkü :-(
işin doğrusu dosya için çok acelem yok önümüzdeki hafta içindede olabilir.
teşekkürler

 

[Korhan Ayhan]

Aşağıdaki kod ile sayfalardaki verileri hızlıca birleştirebilirsiniz.

Option Explicit

Sub SAYFALARDAKI_VERILERI_BIRLESTIR()
    Dim Sayfa As Worksheet, S1 As Worksheet
    Dim X As Long, Satir As Long
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Set S1 = Sheets("TOPLAM")
    S1.Range("A2:E" & Rows.Count).ClearContents
    Satir = 2
    
    For Each Sayfa In ThisWorkbook.Worksheets
        If Sayfa.Name <> "TOPLAM" Then
            With Sayfa.Range("F2:F" & Sayfa.Cells(Rows.Count, 1).End(3).Row)
                .Formula = "=A2&B2&C2&D2&E2"
                .Value = .Value
            End With
            
            For X = 2 To Sayfa.Cells(Rows.Count, 1).End(3).Row
                If WorksheetFunction.CountIf(S1.Range("F:F"), Sayfa.Cells(X, "F")) = 0 Then
                    S1.Range("A" & Satir & ":E" & Satir).Value = Sayfa.Range("A" & X & ":E" & X).Value
                    S1.Cells(Satir, "F") = S1.Cells(Satir, "A") & S1.Cells(Satir, "B") & S1.Cells(Satir, "C") & S1.Cells(Satir, "D") & S1.Cells(Satir, "E")
                    Satir = Satir + 1
                End If
            Next
        End If
    Next

    For Each Sayfa In ThisWorkbook.Worksheets
        Sayfa.Range("F:F").Clear
    Next
    
    Set S1 = Nothing
    
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[erkan1907]

En kısa zamanda deniyecem.
Çok teşekkür ederim.

 

[erkan1907]

Kodu denedim, Allah razı olsun.
Çok teşekkür ederim.