makro ile Sayfalar arası şartlı toplam almak

[numan şamil]

Merhabalar
100 civarında excel çalışma sayfam var (Bu sayfa sayıları değişkendir)
Ekli dosyada bir örnek dosya hazırladım
Örnek dosyada
C sayfası ile I sayfası arasındaki sayfalarda L3=AS. koşulunu sağlayan sayfalardaki B6 hücrelerindeki verilerin toplamını TABLO sayfasındaki C5 hücresine makro ile yazdırmak
Not: örnek dosyada TABLO sayfasındaki C5 hücresine alınacak toplam değer manuel girilmiştir.
Aynı standartlarda 48 adet hücreye bu şekilde veri alınacaktır
ek teki örnek makro ile yapılırsa diğerlerini ben ekleyebilirim
İlgilenenlere teşekkür ederim

 

[usubaykan]

Merhabalar
100 civarında excel çalışma sayfam var (Bu sayfa sayıları değişkendir)
Ekli dosyada bir örnek dosya hazırladım
Örnek dosyada
C sayfası ile I sayfası arasındaki sayfalarda L3=AS. koşulunu sağlayan sayfalardaki B6 hücrelerindeki verilerin toplamını TABLO sayfasındaki C5 hücresine makro ile yazdırmak
Not: örnek dosyada TABLO sayfasındaki C5 hücresine alınacak toplam değer manuel girilmiştir.
Aynı standartlarda 48 adet hücreye bu şekilde veri alınacaktır
ek teki örnek makro ile yapılırsa diğerlerini ben ekleyebilirim
İlgilenenlere teşekkür ederim

Merhaba;

Option Explicit
Sub sayfalardan_topla()
Dim SAYFA As Worksheet
Sheets("TABLO").Range("C5").ClearContents
For Each SAYFA In ThisWorkbook.Worksheets
    If SAYFA.Range("L3") = "AS." And SAYFA.Name <> "TABLO" Then
        Sheets("TABLO").Range("C5") = SAYFA.Range("B6") + Sheets("TABLO").Range("C5")
    End If
Next
End Sub

bu şekildemi olacak?

 

[mersilen]

Merhaba
öncelikle sayfa adları değişken ve sayısı belirsiz olduğundan yardımcı bir sütun kullanılarak isimler yazılmalı ve sonra silinebilir

Option Explicit
Sub yap()
Dim i, x As Integer
Dim topla, name As Variant
For i = 1 To Sheets.Count
Cells(i, 1) = Sheets(i).name 'sayfa isimlerini yazdırmak için
Next
topla = 0
For x = 1 To Cells(Rows.Count, 1).End(xlUp).Row
name = Cells(x, "a").Value
If name <> "TABLO" Then If Sheets(name).Cells(3, "L") = "AS." Then topla = topla + Sheets(name).Cells(6, "b")

Next x
Cells(5, "c") = topla
Range("a1:a" & (Cells(Rows.Count, 1).End(xlUp).Row)).Value = "" ' yardımcı sütunu silmek için

End Sub

 

[numan şamil]

Sn:Usubaykan ve Sn:Mersilen
Çok teşekkür ederim.
Sanırım arkadaşlar
1 nolu mesajımda bahsettiğim "C sayfası ile I sayfası arasındaki sayfalarda L3=AS. koşulunu sağlayan sayfalardaki B6 hücrelerindeki verilerin toplamını TABLO sayfasındaki C5 hücresine makro ile yazdırmak"
Kırmızı bölümü atlamışlar

Sn:Usubaykanın
Sheets("TABLO").Range("C5") = SAYFA.Range("B6") + Sheets("TABLO").Range("C5") kodu ilham kaynağım oldu
Kodları aşağıdaki gibi dizayn ettim ve istediğim sonuca ulaştım
Sub düzenle()
Dim S1 As Worksheet, SAYFA As Worksheet
Set S1 = Sheets("TABLO")
Range("C5").ClearContents
Application.ScreenUpdating = False
For Each SAYFA In ThisWorkbook.Worksheets
If SAYFA.Index > Sheets("C").Index And SAYFA.Index < Sheets("I").Index Then
If SAYFA.Range("L3") = "AS." Then
S1.Range("C5") = SAYFA.Range("B6") + S1.Range("C5")

End If
End If
Next

Set S1 = Nothing
Application.ScreenUpdating = True
End Sub

 

[usubaykan]

Sn:Usubaykan ve Sn:Mersilen
Çok teşekkür ederim.
Sanırım arkadaşlar
1 nolu mesajımda bahsettiğim "C sayfası ile I sayfası arasındaki sayfalarda L3=AS. koşulunu sağlayan sayfalardaki B6 hücrelerindeki verilerin toplamını TABLO sayfasındaki C5 hücresine makro ile yazdırmak"
Kırmızı bölümü atlamışlar

Sn:Usubaykanın
Sheets("TABLO").Range("C5") = SAYFA.Range("B6") + Sheets("TABLO").Range("C5") kodu ilham kaynağım oldu
Kodları aşağıdaki gibi dizayn ettim ve istediğim sonuca ulaştım
Sub düzenle()
Dim S1 As Worksheet, SAYFA As Worksheet
Set S1 = Sheets("TABLO")
Range("C5").ClearContents
Application.ScreenUpdating = False
For Each SAYFA In ThisWorkbook.Worksheets
If SAYFA.Index > Sheets("C").Index And SAYFA.Index < Sheets("I").Index Then
If SAYFA.Range("L3") = "AS." Then
S1.Range("C5") = SAYFA.Range("B6") + S1.Range("C5")

End If
End If
Next

Set S1 = Nothing
Application.ScreenUpdating = True
End Sub

Hayırlı olsun