Sütun sonunda otomatik toplam alma

[elevisse]

Arkadaşlar merhaba,
H4 başlayarak tutarlar bulunmaktadır. H sütunundaki en son dolu hücreden sonra toplama (H4:H?) ihtiyacım vardır. Örneğin H4 ile H153 arasında tutarlarım var. H153 den sonra bir satır boşluk bırakıp H155 toplam almasını istiyorum. H153 ile aynı hizada bulunan J153 satırını ve H155 satırını kırmızı renkli ve Bold yapacak ve aynı zamanda I153 deki hücreyi I155 kopyalayacak makroya ihtiyacım vardır. Ekte örneğin görüntüsünü bulabilirsiniz. Yardımlarınızı rica ederim.

 

[bedersu]

Sayın elevisse,
Bu şekilde resim koymak yerine örnek dosya koyarsanız her zaman daha hızlı ve daha doğru cevaplar alırsınız.Bu şekilde sadece resim koyarak cevap vermek isteyen arkadaşları tek tek veri girerek yeniden dosya hazırlamaya mecbur bırakırsınız.Buna da bir çok kişi girmez.

Aşağıdaki kod en son dolu hücrenin satır numarasını verir.Burada yola çıkarak istediğinizi yapabilirsiniz.Yapamazsanız örnek dosya ekleyerek takıldığınız yeri belirtiniz.Sorunun diğer kısımları makro kaydet ile de yapılabilir.

a = Range("H65536").End(3).Row

 

[elevisse]

Arkadaşlar Merhaba,
Toplam almayı ve I sütunundaki son satırı aşağıdaki kodlarla yapabildim. Son olarak H,I,J sütunundaki en sondaki girişleri Kırmızı renkli ve Kalın olarak şekillendirmek için yardımınızı rica ederim. Teşekkürler.

Sub test()

Dim c As Long
H = 8 'for Column C
Cells(Rows.Count, H).End(xlUp)(3).FormulaR1C1 = "=Sum(R1C:R[-1]C)"

Dim son As Long
    son = Cells(Rows.Count, "I").End(xlUp).Row
    Range("I" & son, "I" & son).Copy Range("I" & son + 2)
 
End Sub

 

[Emir Hüseyin Çoban]

. . .

Hson = [H65536].End(3).Row
Ison = [I65536].End(3).Row
Json = [J65536].End(3).Row

Cells(Hson, "H").Font.Bold = True
Cells(Hson, "H").Font.ColorIndex = 3

Cells(Ison, "I").Font.Bold = True
Cells(Ison, "I").Font.ColorIndex = 3

Cells(Json, "J").Font.Bold = True
Cells(Json, "J").Font.ColorIndex = 3

. . .

 

[elevisse]

Hüseyin Bey merhaba,
Yardımınız için çok teşekkürler. Kodlar şimdi ihtiyacım olduğu gibi çalışıyor.

Sub test()

Dim c As Long
H = 8 'for Column C
Cells(Rows.Count, H).End(xlUp)(3).FormulaR1C1 = "=Sum(R1C:R[-1]C)"

Dim son As Long
    son = Cells(Rows.Count, "I").End(xlUp).Row
    Range("I" & son, "I" & son).Copy Range("I" & son + 2)
 
Hson = [H65536].End(3).Row
Ison = [I65536].End(3).Row
Json = [J65536].End(3).Row

Cells(Hson, "H").Font.Bold = True
Cells(Hson, "H").Font.ColorIndex = 3

Cells(Ison, "I").Font.Bold = True
Cells(Ison, "I").Font.ColorIndex = 3

Cells(Json, "J").Font.Bold = True
Cells(Json, "J").Font.ColorIndex = 3

 
End Sub