Çözüldü SATIR SEÇ AKTAR VE TOPLAMINI AL

[zulfuernek]

ekteki dosyada sayfaların A3 ile Q3 verilerini kopyalayarak toplam sayfadaki satırlara sırasıyla bağ yapıştır medtoduyla aktarma yapıyor ve ilgili sütunlara ait toplamları alt satırda gösteeiyor. benim istediğim ise bu olayı makro ile butona aktarabilirim. fakat şöyle bir husus var bağ yapıştır olayında boş hücreler sıfır göründüğü için sıfır olarak görünmesini istemiyorum

 

[Muzaffer Ali]

Merhaba.

Aşağıdaki kodlar ile yapabilirsiniz.
Kodları "TOPLAMLAR" adlı sayfanın kod bölümüne kopyalayarak çalıştırın.

Sub Test()
    Dim Bak As Integer
    Worksheets("Sayfa1").Range("A3:Q3").Copy
    Range("A1").PasteSpecial Paste:=xlPasteValues
    Worksheets("Sayfa2").Range("A3:Q3").Copy
    Range("A2").PasteSpecial Paste:=xlPasteValues
    Worksheets("Sayfa3").Range("A3:Q3").Copy
    Range("A3").PasteSpecial Paste:=xlPasteValues
    Range("A5:Q5").ClearContents
    For Bak = 1 To 17
        If WorksheetFunction.Sum(Cells(1, Bak), Cells(2, Bak), Cells(3, Bak)) > 0 Then
            Cells(5, Bak) = WorksheetFunction.Sum(Cells(1, Bak), Cells(2, Bak), Cells(3, Bak))
        End If
    Next
End Sub

 

[zulfuernek]

@dalgalikur hocam emeklerine saglik tam istedigim gibi oldu. cok tesekkur ederim

 

[zulfuernek]

@dalgalikur hocam bu kodlaya alternatif olarak asagida verdigim formule uygun kodlama yapabilirmiyiz.

=TOPLA(Sayfa2:Sayfa6!A2:A17)
Buformul 3-B yontemiyle sayfa1 ile sayfa3 arasindaki sayfalarin A2 hucresini topluyor. sayfa 1 ile sayfa 3 arasina sayfa ekleyip sayfa silsem dahi kalan sayfalarin hucre toplamlarini aliyor ve hangi hucreye yazmissam sonucu oraya yaziyor. bunu sayfa 4 e gene ilgili sutunlara toplamini almasi icin nasil bir kodlama yapabiliriz. ancak sifir degerleri gorunmemeli

ayrintili ornek:
https://support.office.com/tr-tr/article/birden-fazla-çalışma-sayfasında-aynı-hücre-aralığına-yönelik-3-b-başvuru-oluşturma-40ca91ff-9dcb-4ad1-99d2-787d0bc888b6

 

[Muzaffer Ali]

Aşağıdaki kod "Sayfa2" ile "Sayfa6" ve arasındaki bütün sayfaların "B2:B17" aralığını toplar "Sayfa4" ün "A1" hücresine yazar.

Sub test()
    Dim Topla
    Topla = Evaluate("Sum(Sayfa2:Sayfa6!B2:B17)")
    If Not Topla = 0 Then
        Sayfa4.Range("A1").Value = Topla
    End If
End Sub

 

[zulfuernek]

@dalgalanır hocam emeğinize sağlık. Deneyeceğim birazdan. Ayrıca her sütünü sayfa 4 de gene aynı sütuna toplamaya uyarlayacağım bakalım inşallah becerebilirim. Yanı b sutundakinj b ye c sunundanım c ye gibi. Emeklerinize saglik

 

[zulfuernek]

@dalgalikur hocam emeginize saglik. Kldlama harika oldu. Ben biraz ugrastim ancak beceremedim. Yani A3 ile Q3 arasindaki hucreleri toplayacak anvak A3 hucrelerini A3e B3 hucrelerini B3 e C3 gucrelerini C3 e toplayacak sekilde yapamadim. Onun icinde yukaridaki kodlamayi

Topla = Evaluate("Sum(Sayfa2:Sayfa6!A3)")
If Not Topla = 0 Then
Sayfa4.Range("A3").Value = Topla
End If

Topla = Evaluate("Sum(Sayfa2:Sayfa6!B3)")
If Not Topla = 0 Then
Sayfa4.Range("B3").Value = Topla
End If

Topla = Evaluate("Sum(Sayfa2:Sayfa6!C3)")
If Not Topla = 0 Then
Sayfa4.Range("C3").Value = Topla
End If

Seklinde Q sutununa gidiyor. Bu kodlamayi tek bir grup halinde yapmamiz mumkunmu malum hem kodlama cok fazla olucak hemde islem acisindan zaman alicak ve userform yorucu oluyor benim yaptigim sekilde

 

[Muzaffer Ali]

Aşağıdaki gibi yapabilirsin.

Sub Test()
    Dim Hucreler As Range
    Dim Bak As Range
    Dim Topla
    Set Hucreler = Range("A3,B3,C3,D3")
    For Each Bak In Hucreler
        Topla = Evaluate("Sum(Sayfa2:Sayfa3!" & Bak.Address & ")")
        If Topla = 0 Then
            Sayfa1.Range(Bak.Address).Value = ""
        Else
            Sayfa1.Range(Bak.Address).Value = Topla
        End If
    Next
End Sub

 

[zulfuernek]

@dalgalikur hocam kodlama çok iyi çalışıyor. Bu kodlamada uyuşmayan bir problem oluştu. sayfa isimşleri normalde sayfa1 sayfa2 sayfa3 iken problem yok ancak sayfa isimleri değiştiği doğal olarak kodlama çlaışmıyor. hata veriyor. ancak biz kodmalada sayfa isimlerini "" tırnak içerisinde belitmemiş gibi görüyorum yani sayfanın kök ismi olan sayfa1 den ile sayfa 3 arasında işlem yapması gerekiyor. bunu nasıl yapabiliriz

 

[Muzaffer Ali]

Topla = Evaluate("Sum(Sayfa2:Sayfa3!" & Bak.Address & ")")

Satırını silip yerine aşağıdakini ekleyin.

Topla = Evaluate("Sum(" & Sayfa1.Name & ":" & Sayfa3.Name & "!" & Bak.Address & ")")

 

[zulfuernek]

@dalgalikur hocam emeğine sağlık çok çok teşekkür ederim.

 

[zulfuernek]

@dalgalikur hocam szden bu konuda bir ricam daha olacak. yukarıdaki kod çalıştı çok güzel emeğinize sağlık. buna bağlı olarak bir ekleme yapabilirmiyiz.

sayfa 1 de A sütununda tarih var. B sütunundan itibarende vriler var

Sayfa 1 de A1:Q1 arasındaki veriyi kopyalayıp Sayfa19 da A1 sütunundan itibaren başlayarak yanyana sıralayacak. ancak şöyle bir ince ayrıntı var. Eğer sayfa19 da A sütununda aynı tarih varsa üzerine yazacak. eğer aynı tarih yoksa bir salt satıra yazacak.

 

[zulfuernek]

özüldü hocam emeğinize sağlık

 

[zulfuernek]

Dim Hucreler As Range