Hesap No Bazında Sayfalar Arası Konsolidasyon

Excel'de ardışık sayfalarda bulunan her bir Şirketin Hesap No bazındaki Tutarlarını, bir sayfada konsolide eden Macro programını aşağıda bulabilirsiniz. 

Her bir sayfada Şirket dışında başka bir birim de olabilir. Hesap No dışında başka kod da kullanılabilir. Tutar yerine Miktar gibi toplama işlemi yapılabilen başka bir değişken de olabilir. 

Bu amaçla Konsolidasyon sayfasında örnekteki gibi bir şekil ekleyin, şeklin içine bir etiket yazın. Bu şekle aşağıdaki Konsolidasyon makrosunu atayın. 

Aşağıdaki görüntü, bir örnek Şirket sayfası görüntüsüdür. 

Bir parametreler sayfası oluşturun. Bu parametreler sayfasının A kolonunda satırlara aşağıdaki Parametreler sayfasındaki isimleri yazın. Bu isimlere karşılık resimdeki gibi kendi veri sayfanıza uygun değerler verin. 

Ölçüt Kolonu, konsolidasyon sayfasındaki Hesap No kolonudur. 

Kontrol Kolonu, şirket sayfalarındaki Hesap No kolonudur. 

Değer Kolonu, şirket sayfalarındaki Tutar kolonudur. 

Sonuç Kolonu, konsolidasyon sayfasındaki Tutar kolonudur. 

'---------------------------------------------------------------------------------------------------------------------

Public Sub Konsolidasyon()
 IlkSayfaAdi = Sheets("Parametreler").Range("B1")
 SonSayfaAdi = Sheets("Parametreler").Range("B2")
 OlcutKolonuNo = Sheets("Parametreler").Range("B3")
 KontrolKolonuNo = Sheets("Parametreler").Range("B4")
 DegerKolonuNo = Sheets("Parametreler").Range("B5")
 SonucKolonuAdi = Sheets("Parametreler").Range("B6")
 
 SonucKolonuNo = Range(SonucKolonuAdi & 1).Column
 rmin = 2
 rmax = WorksheetFunction.CountA(Range("A1:A1000000"))
 For r = rmin To rmax
  Cells(r, SonucKolonuNo) = OzelKosulluTopla(r, IlkSayfaAdi, SonSayfaAdi, OlcutKolonuNo, KontrolKolonuNo, DegerKolonuNo)
 Next r
End Sub

'---------------------------------------------------------------------------------------------------------------------

Private Function OzelKosulluTopla(ByVal SatirNo As Integer, ByVal IlkSayfaAdi As String, ByVal SonSayfaAdi As String, _
                                  ByVal OlcutKolonuNo As Integer, ByVal KontrolKolonuNo As Integer, ByVal DegerKolonuNo As Integer) As String
 ns = Sheets.Count
 smin = 0: smax = 0
 For s = 1 To ns
  If Sheets(s).Name = IlkSayfaAdi Then
   smin = s
  Else
   If Sheets(s).Name = SonSayfaAdi Then
    smax = s
   End If
  End If
  If smin <> 0 And smax <> 0 Then
   Exit For
  End If
 Next s
 KontrolKolonuAdi = Chr(KontrolKolonuNo + 64)
 Toplam = 0
 For s = smin To smax
  rmin = 2
  rmax = WorksheetFunction.CountA(Sheets(s).Range(KontrolKolonuAdi & "1:" & KontrolKolonuAdi & "1000000"))
  For r = rmin To 10
   If Sheets(s).Cells(r, KontrolKolonuNo) = Sheets(1).Cells(SatirNo, OlcutKolonuNo) Then
    Toplam = Toplam + Sheets(s).Cells(r, DegerKolonuNo)
   End If
  Next r
 Next s
 OzelKosulluTopla = Toplam
End Function