macro'ya ek toplam aldırma yardım

[hüseyintok]

merhaba ekteki tablomda çalışan macroma ilave yaparak Rapor sheetinde herbir grubun satış fiyatı ve maliyet stunlarının son satırına dip toplamlarını aldırmak için yardım rica ediyorum.

 

[AdemCan]

Merhaba, kodu güncelleyiniz, toplam satırlarını ekledim.

Sub Veri_Aktar()
'28.02.2022  12:25
    
Cells.Delete Shift:=xlUp

DoEvents

 timer1 = Timer
 Do While Timer - timer1 < 0.3
 Loop

DoEvents


Application.ScreenUpdating = False

        Kaynak_Sayfa = "Sube_Hareketleri"

        sona = Sheets(Kaynak_Sayfa).Cells(Rows.Count, 1).End(3).Row

'        Dim Dizi(0), dizi1(0)
        ReDim Dizi(sona, 9), dizi1(sona)
        
        dizi1say = 0

        For i = 2 To sona

            For j = 1 To 9

                Dizi(i, j) = Trim(Sheets(Kaynak_Sayfa).Cells(i, j))

            Next

        Next


        For i = 1 To sona

            If Len(Trim(Dizi(i, 1))) < 1 Then GoTo uç1

            For j = 1 To dizi1say

                If Dizi(i, 1) = dizi1(j) Then GoTo uç1

            Next

            dizi1say = dizi1say + 1
            dizi1(dizi1say) = Trim(Dizi(i, 1))

uç1:

        Next


        For i1 = 1 To dizi1say
            For i2 = 1 To dizi1say

                If dizi1(i1) < dizi1(i2) Then
                    
                    bos = dizi1(i1)
                    dizi1(i1) = dizi1(i2)
                    dizi1(i2) = bos
                
                
                End If
            
            Next
        Next
        
        
        For i = 1 To dizi1say

            metin1 = metin1 & ",  " & dizi1(i)

        Next
        
'        MsgBox metin1
        
        
        
        Cells(1, 7) = Date
        Cells(1, 8) = Time
        
        
        Cells(1, 7).Select
        
        say = 1
        
        
        
        For i = 1 To dizi1say
            
            say = say + 1
            
'            MsgBox Say

            Cells(say, 1) = dizi1(i)
            
            With Range("A" & say & ":H" & say)
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlBottom
                .WrapText = False
                .Orientation = 0
                .AddIndent = False
                .IndentLevel = 0
                .ShrinkToFit = False
                .ReadingOrder = xlContext
                .MergeCells = False
            End With
            Range("A" & say & ":H" & say).Merge
            With Range("A" & say & ":H" & say).Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .ThemeColor = xlThemeColorDark1
                .TintAndShade = -0.149998474074526
                .PatternTintAndShade = 0
            End With
            Range("A" & say & ":H" & say).Font.Bold = True
            depo = Range("A" & say).Row
            say = say + 1
          
            For j = 2 To 9
                
                Cells(say, j - 1) = Sheets(Kaynak_Sayfa).Cells(1, j)
                
            Next
            
            Range("A" & say & ":H" & say).Font.Bold = True
            
            For ii = 1 To sona
                
                If Dizi(ii, 1) = dizi1(i) Then
                    
                    say = say + 1
'                    MsgBox Say
                    
                    For j = 2 To 9
                
                        Cells(say, j - 1) = Dizi(ii, j)
                
                    Next
                
                End If
            
            Next
            say = say + 1
            
            Range("E" & say) = "TOPLAM"
            Range("E" & say).Font.Bold = True
            Range("F" & say) = WorksheetFunction.Sum(Range("F" & depo + 2 & ":F" & say - 1))
            Range("F" & say).Font.Bold = True
            Range("G" & say) = WorksheetFunction.Sum(Range("G" & depo + 2 & ":G" & say - 1))
            Range("G" & say).Font.Bold = True
            say = say + 2
'            MsgBox Say

        Next
        
        Columns("A:A").NumberFormat = "0"
        Cells.EntireColumn.AutoFit
        Cells.HorizontalAlignment = xlCenter
        Cells.VerticalAlignment = xlCenter
        
        Application.ScreenUpdating = True
End Sub

 

[hüseyintok]

Adem bey teşekkürler