alttoplam ekleme, bölmeleri dondurma

[Erdem Akdemir]

ekteki dosyadaki makroyu çalıştırdıktan sonra

g3 ve h3 hücresine alttoplam aldırmak istiyorum ama satır sayısını otomatik ayarlayamadım

birde kod çalıştıktan sonra 5.satırdan itibaren bölmeleri dondurmasını istiyorum ama devamlı hata veriyor

yardımlarınızı bekliyorum.

 

[Levent Menteşoğlu]

Aşağıdaki gibi deneyin.

Sub butce()
Columns(2).Insert Shift:=xlToRight
Columns(1).Insert Shift:=xlToRight
Dim rng As Integer
For rng = 6 To Range("b65536").End(xlUp).Row - 1
Cells(rng, 3) = Mid(Cells(rng, 2), 1, 3)
Cells(rng, 9) = Len(Range("b" & rng))
Cells(rng, 1) = Mid(Cells(rng, 2), 1, 1)
Next rng
[c4] = "Kısa Kod"
[i4] = "x2"
[a4] = "x1"
Cells.EntireColumn.AutoFit
Rows("4:4").AutoFilter
Rows("5:5").Delete Shift:=xlUp
Rows("5:5").Select
ActiveWindow.FreezePanes = True
sonsat = [a65536].End(3).Row
Range("G3").Formula = "=SUBTOTAL(109,G5:G" & sonsat & ")"
Range("H3").Formula = "=SUBTOTAL(109,H5:H" & sonsat & ")"
End Sub

 

[Erdem Akdemir]

Aşağıdaki gibi deneyin.

Sub butce()
Columns(2).Insert Shift:=xlToRight
Columns(1).Insert Shift:=xlToRight
Dim rng As Integer
For rng = 6 To Range("b65536").End(xlUp).Row - 1
Cells(rng, 3) = Mid(Cells(rng, 2), 1, 3)
Cells(rng, 9) = Len(Range("b" & rng))
Cells(rng, 1) = Mid(Cells(rng, 2), 1, 1)
Next rng
[c4] = "Kısa Kod"
[i4] = "x2"
[a4] = "x1"
Cells.EntireColumn.AutoFit
Rows("4:4").AutoFilter
Rows("5:5").Delete Shift:=xlUp
Rows("5:5").Select
ActiveWindow.FreezePanes = True
sonsat = [a65536].End(3).Row
Range("G3").Formula = "=SUBTOTAL(109,G5:G" & sonsat & ")"
Range("H3").Formula = "=SUBTOTAL(109,H5:H" & sonsat & ")"
End Sub

üstadım sağolun , elleriniz ders görmesin