"Bankalara Verilen Evraklar" son sayfada toplama

[arifaksamc]

Ekteki dosyada yapmak istediğim şey 1. 2. 3. sayfalara girdiğim )hangi sayfaya girersem gireyim) verilerin aynı anda "Toplam" sayfasında eklenmesi. Daha öncede buna benzer bir soru sormuştum ama çözüm bir buton koyup her istediğmde butona tıklamak şeklinde olmasın istiyorum. yani veriler girdiğim an "Toplam" sayfasına aktarılsın. Belki "Bağ yapıştır" komutu işimi görebilir ama sorun son girdiğim verinin en sona eklenmesi (tabi verileri toplam sayfasında "vade"ye görede sıralayabiliriz). Biraz uzun oldu ama, şimdiden yardımlarınız için teşekkürler...

 

[Ferhat Pazarçevirdi]

Aşağıdaki kodları "TOPLAM" adlı sayfanın kod modülüne kopyalayınız.

Sayfaya her girişinizde tüm kayıtlar, bu sayfaya toplanmış olacaktır.

Private Sub Worksheet_Activate()
 
    Dim wks As Worksheet
    Dim rng As Range
 
    Application.Calculation = xlCalculationManual
 
    If UsedRange.Rows.Count >= 2 Then
        Rows("2:" & UsedRange.Rows.Count).Delete
    End If
 
    For Each wks In ThisWorkbook.Worksheets
        With wks
            If .Name <> ActiveSheet.Name Then
                .UsedRange.Offset(1, 0).Copy Cells(UsedRange.Rows.Count + 1, 1)
            End If
        End With
    Next
 
    With Application
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With
 
End Sub

 

[memo85]

Arif kardeş önce sana teşekkürler ben de bu sorunu çözmeye çalışıyordum. Ferhat kardeş senin de emeğine sağlık. Bişey soracağım bunu exceldeki yerleşik formüllerle yapamazmıyız? Bir de Ferhat kardeş kod olayına yeni başlayanlar için (benim gibi) bu kodu yazarken açıklama satırı ekleyerek yazar mısın nerde ne yapmak istedin. Az çok anlıyoruz ama işte bi yerde kalıyoz. şimdiden teşekkür ederim. zahmet verdim kusura bakma.

 

[Ferhat Pazarçevirdi]

Arif kardeş önce sana teşekkürler ben de bu sorunu çözmeye çalışıyordum. Ferhat kardeş senin de emeğine sağlık. Bişey soracağım bunu exceldeki yerleşik formüllerle yapamazmıyız? Bir de Ferhat kardeş kod olayına yeni başlayanlar için (benim gibi) bu kodu yazarken açıklama satırı ekleyerek yazar mısın nerde ne yapmak istedin. Az çok anlıyoruz ama işte bi yerde kalıyoz. şimdiden teşekkür ederim. zahmet verdim kusura bakma.

Aşağıdaki açıklamaları inceleyiniz.

Private Sub Worksheet_Activate()
    
    Dim wks As Worksheet
    
[COLOR=darkgreen]    'Excel'in hesaplama yeteneğini elle tetiklenir konuma getiriyoruz
      'Çünkü, sayfa üzerinde yapacağımız işlemler,
      'otomatik hesaplamayı tetikleyecek ve
      'hesaplamalar tamamlanana kadar komutlar işlenemeyecekti ...
      'Bu da, makronun ağır çalışmasına sebep olacaktı ...[/COLOR]
    Application.Calculation = xlCalculationManual
    
    
[COLOR=darkgreen]    'Öncelikle, "Toplam" adlı sayfada,
    'halihazırda ne kadar veri varsa
    'hepsinin temizlenmesi sağlanacak
      'Bunun için, Toplam sayfasınının
      'kullanım alanındaki (usedrange) satır sayısını bulmalıydık.
      '2.satırdan başlamak üzere
      'son kullanılan satıra kadar
      'tüm satırları sileceğiz[/COLOR]
    If UsedRange.Rows.Count >= 2 Then
        Rows("2:" & UsedRange.Rows.Count).Delete
    End If
    
[COLOR=darkgreen]    'Bu çalışma kitabındaki tüm sayfalar
    'tek tek elden geçirilecek
      'Bunun için Worksheets collection'dan faydalanarak,
      'bir döngü oluşturduk
      'Döngü içerisinde herbir sayfaya geldiğimizde,
      'bu worksheet'in kullanım alanını bularak,
      'ilk satır dahil olmamak üzere
      'geri kalan tüm satırları kopyalayıp,
      '"TOPLAM" sayfasındaki en son kullanılan satırın bir altına
      'kopyaladığımız verileri yapıştırıyoruz
      'Bu bütün sayfalar taranana kadar devam ediyor...[/COLOR]
      
    For Each wks In ThisWorkbook.Worksheets
        With wks
            If .Name <> ActiveSheet.Name Then
                .UsedRange.Offset(1, 0).Copy Cells(UsedRange.Rows.Count + 1, 1)
            End If
        End With
    Next
    
[COLOR=darkgreen]    'Excel'in hesaplama yeteneğini,
    'yeniden otomatik pozisyonuna getiriyoruz ve
    'Ekran yenilemeyi etkinleştiriyoruz[/COLOR]
    With Application
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With
    
End Sub

 

[memo85]

ferhat kardeşim teşekkür ederim. biz sizlere bi konuda yardımcı olmuyoruz ama siz sabrınızla bizleri bilgilendiriyorsunuz. emeğine sağlık.

 

[arifaksamc]

"Ferhat Pazarçevirdi" cevabınız için teşekkürler. Siz ve sizin gibi ustalarımızın sayesinde bişeyler yapabilir hale geleceğiz