• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

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

Katılım
28 Ocak 2008
Mesajlar
96
Excel Vers. ve Dili
Office 2010
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.
 

Ekli dosyalar

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.
 
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
 
Aşağıdaki kod ile sayfalardaki verileri hızlıca birleştirebilirsiniz.

Kod:
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
 
Kodu denedim, Allah razı olsun.
Çok teşekkür ederim.
 
Geri
Üst