Çözüldü Farklı Sayfalardan Değerleri Toplama/Sıralı Yazdırma

[gicimi]

Merhaba;

Yapılmak istenilen;
Sayfa1'in, Sayfa2'nin ve Sayfa3'ün (A) sütunundaki değerlerin toplamını "Genel Toplam" sayfasına sıralı olarak makro ile yazdırmaktır.

Verilen bu örnekte sayfa sayısı kısıtlı tutulmuştur,asıl belgede sayfa sayısı 50' yi bulabilmektedir.

 

[Orion1]

Merhaba;

Yapılmak istenilen;
Sayfa1'in, Sayfa2'nin ve Sayfa3'ün (A) sütunundaki değerlerin toplamını "Genel Toplam" sayfasına sıralı olarak makro ile yazdırmaktır.

Verilen bu örnekte sayfa sayısı kısıtlı tutulmuştur,asıl belgede sayfa sayısı 50' yi bulabilmektedir.

Genel Toplam sayfası hep en sonda olmalıdır.
Dosyanız ektedir.

Sub toplama59()
Dim sh As Worksheet, sonsat As Long, i As Long
Dim tpl As Double, j As Integer
Sheets("Genel Toplam").Select
Range("B1:B15").ClearContents
For i = 1 To 15
    For j = 1 To Worksheets.Count - 1
        Set sh = Sheets(j)
        sonsat = sh.Cells(Rows.Count, "A").End(xlUp).Row
        tpl = tpl + WorksheetFunction.SumIf(sh.Range("A1:A" & sonsat), Cells(i, "A"), sh.Range("B1:B" & sonsat))
    Next j
    Cells(i, "B").Value = tpl
    tpl = 0
Next i
MsgBox "İşlem Tamam"
End Sub

 

[gicimi]

Sn. @Orion1 teşekkür ederim. İyi Çalışmalar.

 

[Orion1]

Sn. @Orion1 teşekkür ederim. İyi Çalışmalar.

Rica ederim.
İyi çalışmalar.

 

[Ömer BARAN]

Merhaba, alternatif olsun.

Genel Toplam sayfası A sütunundaki verilerin hazır olmadığını düşünmüştüm.
A sütununu da kod üzerinden oluşturmak isterseniz aşağıdaki kod'u kullanabilirsiniz.

Sub SAYFA_TOPLAMLARI()
Set gt = Sheets("Genel Toplam")
gt.[A:B].Clear
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
For Each shf In ThisWorkbook.Sheets
    If shf.Name <> "Genel Toplam" Then
        shf.Range("A1:A" & shf.Cells(Rows.Count, 1).End(3).Row).Copy _
        gt.Cells(gt.Cells(Rows.Count, 1).End(3).Row + 1, 1)
    End If
Next
gt.Range("A2:A" & gt.Cells(Rows.Count, 1).End(3).Row).Sort Key1:=gt.[A2], Order1:=1
gt.[A:A].RemoveDuplicates Columns:=1, Header:=xlNo
For Each shf In ThisWorkbook.Sheets
    If shf.Name <> "Genel Toplam" Then
        For sat = 1 To shf.Cells(Rows.Count, 1).End(3).Row
            gtsat = WorksheetFunction.Match(shf.Cells(sat, 1), gt.[A:A], 0)
            gt.Cells(gtsat, 2) = gt.Cells(gtsat, 2) + shf.Cells(sat, 2)
        Next
    End If
Next
gtson = gt.Cells(Rows.Count, 1).End(3).Row + 1
gt.Cells(gtson, 1) = "GENEL TOPLAM"
gt.Cells(gtson, 2) = WorksheetFunction.Sum(gt.Range("B2:B" & gtson + 1))
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
MsgBox "İşlem tamamlandı.", vbInformation, "..:: Ömer BARAN ::.."
End Sub

 

[gicimi]

Sn. @Ömer BARAN alternatif kod için teşekkür ederim.

 

[Ömer BARAN]

Kolay gelsin.

 

[Korhan Ayhan]

Bir alternatifte ben sunayım.

 

[gicimi]

Sn. @Korhan Ayhan teşekkür ederim.