topla dedikten sonra bitsin sonra tekrar toplasın

[Meteynclk]

Herkese Merhaba

arkadaşlar şöyle bir sorunum var "sayfa2" den "sayfa1 e" "malzeme çağır" butonuna basınca tek tek malzemeler geliyor tam istediğim gibi "topla" dediğim zaman da aşağıda topluyor ama ben bir kere daha malzeme ekle dedikten sonra topla bir kere daha basınca bütün sütunlar toplanıyor ben sadice ilk toplama işlemi bitti ilk seçilen malzeme getir bastığım zaman sadice en son toplanan getirilsin istiyorum bi yardımcı olursanız sevinirim.

calisma.xlsx dosyasını indir - download

calisma.xlsx dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

s6.dosya.tc

 

[Korhan Ayhan]

Deneyiniz.

B sütununda işlem yapar..

Option Explicit

Sub Topla()
    Dim Bul As Range
    
    Set Bul = Range("A1:A" & Cells(Rows.Count, 1).End(3).Row).Find("toplam*", Range("A18"), , xlWhole, , xlPrevious)
    If Not Bul Is Nothing Then
        If Left(Cells(Rows.Count, 1).End(3), 6) <> "toplam" Then
            Cells(Rows.Count, 1).End(3)(2, 1) = "toplam"
            Cells(Rows.Count, 2).End(3)(2, 1) = WorksheetFunction.Sum(Range("B" & Bul.Row + 1 & ":B" & Cells(Rows.Count, 2).End(3).Row))
        End If
    Else
        Cells(Rows.Count, 1).End(3)(2, 1) = "toplam"
        Cells(Rows.Count, 2).End(3)(2, 1) = WorksheetFunction.Sum(Range("B" & Cells(Rows.Count, 2).End(3).End(3).Row & ":B" & Cells(Rows.Count, 2).End(3).Row))
    End If
End Sub

 

[Meteynclk]

Deneyiniz.

B sütununda işlem yapar..

Option Explicit

Sub Topla()
    Dim Bul As Range
   
    Set Bul = Range("A1:A" & Cells(Rows.Count, 1).End(3).Row).Find("toplam*", Range("A18"), , xlWhole, , xlPrevious)
    If Not Bul Is Nothing Then
        If Left(Cells(Rows.Count, 1).End(3), 6) <> "toplam" Then
            Cells(Rows.Count, 1).End(3)(2, 1) = "toplam"
            Cells(Rows.Count, 2).End(3)(2, 1) = WorksheetFunction.Sum(Range("B" & Bul.Row + 1 & ":B" & Cells(Rows.Count, 2).End(3).Row))
        End If
    Else
        Cells(Rows.Count, 1).End(3)(2, 1) = "toplam"
        Cells(Rows.Count, 2).End(3)(2, 1) = WorksheetFunction.Sum(Range("B" & Cells(Rows.Count, 2).End(3).End(3).Row & ":B" & Cells(Rows.Count, 2).End(3).Row))
    End If
End Sub

hocam çok teşekkür ederim allah razı olsun