Soru En Son Dolu Hücrenin Altına Toplam Almak,

[bulentkars]

Arkadaşlar Merhaba,
Ekteki tabloda örnek ile anlattım,

"C2:AE" Sutunlarının en son hücreye sutunların toplamını almak istiyorum, Yardımcı Olabilirseniz sevinirim.

 

[muygun]

Merhaba;
Eki deneyin.
İyi çalışmalar.

 

[bulentkars]

Sayın Muygun,

Çok Teşekkür ederim. Elinize Sağlık..

 

[AdemCan]

Merhaba alternatif örnek.

Sub test()
Application.ScreenUpdating = False
Dim c As Long, i As Long, r As Long

c = Cells(1, Columns.Count).End(1).Column
r = Cells(Rows.Count, 1).End(3).Row
Range(Cells(r + 2, 2), Cells(r + 2, c)).Clear

With Cells(r + 2, 2)
    .Value = "Genel Toplam"
    .Font.Bold = True
End With

For i = 3 To c
    With Cells(r + 2, i)
        .Value = WorksheetFunction.Sum(Range(Cells(2, i), Cells(r, i)))
        .Font.Bold = True
        .NumberFormat = "#,##0"
    End With
Next i

Range(Cells(1, 1), Cells(r, c)).Borders.LineStyle = xlContinuous

Application.ScreenUpdating = True
End Sub

 

[bulentkars]

Ademcan Bey,

Çok Teşkkürler, Buda güzelll elinize sağlık

 

[veyselemre]

Alternatif olsun.

Sub test()
    Application.ScreenUpdating = False
    
    With Range("A" & Cells(Rows.Count, 1).End(xlUp).Row + 1 & ":AE" & Rows.Count)
        .ClearContents
        .Borders.LineStyle = xlNone
        .Font.Bold = False
        With .Resize(1).Offset(1, 1)
            .Cells(1).Value = "Genel Toplam"
            With .Offset(, 1).Resize(, .Cells.Count - 2)
                .FormulaR1C1 = "=SUM(R2C:R[-2]C)"
                .Value = .Value
            End With
            With .Resize(, .Cells.Count - 1)
                .Font.Size = 12
                .Font.Bold = True
                .Borders.LineStyle = xlContinuous
            End With
        End With
    End With

    Application.ScreenUpdating = True
    MsgBox "İşlem TAMAM.", vbInformation
End Sub

 

[bulentkars]

Veysel Emre Bey,

Çok Teşekkür ederim.