Aktarılan Tabloda İstenilen İşlemin Otomatik Yapılması

[nur_u_allah]

Hocalarım;
eklediğim çalışmada rapor sayfasına end gprs sayfasındaki verileri aktarırken işlem yapmaktadır.
Burada hiç bir sorunum yok.
Sadece üç tane ek işlem eklemek isitiyorum.
Bunlar;
Oran alanını rapor sayfasındaki verilerin en sonuna eklemesi lazım
Oran hesaplatırken (hakediş sütünu + az tuketim sutunu)* 100 / verilen abone sayısı ele alınacak eklemeyi unutmuşum.
1-en alttaki toplam satırlarınında rapora aktarılması lazım
2-başlıklar her raporda farklı olduğu için RAPOR sayfasına aktarım yaparken başlık alanlarınıda aktarma şanşımız varmıdır.

Saygılarımla Şimdiden yapacağınız yardımlar için teşekkür ederim.

 

[halit3]

kod aşağıdaki mesajda

 

[nur_u_allah]

Hocam oran alma tamam ama oranları yanlış alıyor
Rapor sayfasının altına doğru oran diye hesaplatma yaptım.
Bakarsanız sevinirim.

 

[halit3]

kod aşağıdaki mesajda

 

[nur_u_allah]

Hocam oranlar yanlış alıyor eklediğim kodda oranlar doğru çalışıyor sadece
toplam satırını eklememiz lazım.

Sub SAYFALARI_AKTARR()
Worksheets("RAPOR").Range("A4:Z6500") = ""
i = 1
k = 1
Do While Worksheets("END_GprsHakedisRaporu").Cells(i + 3, 1) <> ""
If Worksheets("END_GprsHakedisRaporu").Cells(i + 3, 5) <> "-1" Then
For j = 1 To 25
Worksheets("RAPOR").Cells(k + 3, j) = Worksheets("END_GprsHakedisRaporu").Cells(i + 3, j)
Next j
Dim oran As Double
oran = _
((Worksheets("RAPOR").Cells(k + 3, "v") + _
Worksheets("RAPOR").Cells(k + 3, "t")) * 100) / _
Worksheets("RAPOR").Cells(k + 3, "e")
Worksheets("RAPOR").Cells(k + 3, "w") = CDbl(FormatNumber(oran, 2)) * 1
k = k + 1
End If
i = i + 1
Loop
oran = Empty
MsgBox "işlem tamam"
End Sub

 

[halit3]

2 türlü kod var ikiside aynı işlemleri yapıyor tırnaklı kapalı olan formüllerin birisi aşağı yuvarlıyor diğeri yukarı yuvarlıyor ondalık sayı bazında istediğini kullanabilirsin

Sub aaSAYFALARI_AKTARR()
Worksheets("RAPOR").Range("A4:Z6500") = ""
i = 1
k = 1
deg = 0
Do While Worksheets("END_GprsHakedisRaporu").Cells(i + 3, 3) <> ""
If Worksheets("END_GprsHakedisRaporu").Cells(i + 3, 5) <> "-1" Then
For j = 1 To 25
Worksheets("RAPOR").Cells(k + 3, j) = Worksheets("END_GprsHakedisRaporu").Cells(i + 3, j)

If j = 23 Then
'Worksheets("RAPOR").Cells(k + 3, j) = WorksheetFunction.Ceiling((Worksheets("RAPOR").Cells(k + 3, 22) + Worksheets("RAPOR").Cells(k + 3, 20)) * 100 / Worksheets("RAPOR").Cells(k + 3, 5), 0.01)
'Worksheets("RAPOR").Cells(k + 3, j) = WorksheetFunction.Floor((Worksheets("RAPOR").Cells(k + 3, 22) + Worksheets("RAPOR").Cells(k + 3, 20)) * 100 / Worksheets("RAPOR").Cells(k + 3, 5), 0.01)
Worksheets("RAPOR").Cells(k + 3, j) = Round((Worksheets("RAPOR").Cells(k + 3, 22) + Worksheets("RAPOR").Cells(k + 3, 20)) * 100 / Worksheets("RAPOR").Cells(k + 3, 5), 2)

deg = deg + CDbl(Worksheets("RAPOR").Cells(k + 3, j))
yer = Worksheets("RAPOR").Cells(k + 3, j)
End If
Next j
k = k + 1
End If
i = i + 1
Loop
MsgBox k + 2
MsgBox yer
Worksheets("RAPOR").Cells(k + 2, 23) = deg - yer
MsgBox "işlem tamam"
End Sub



Sub SAYFALARI_AKTARR()
Worksheets("RAPOR").Range("A4:Z6500") = ""
i = 1
k = 1
Do While Worksheets("END_GprsHakedisRaporu").Cells(i + 3, 3) <> ""
If Worksheets("END_GprsHakedisRaporu").Cells(i + 3, 5) <> "-1" Then
For j = 1 To 25
Worksheets("RAPOR").Cells(k + 3, j) = Worksheets("END_GprsHakedisRaporu").Cells(i + 3, j)
Next j
Dim oran As Double
oran = _
((Worksheets("RAPOR").Cells(k + 3, "v") + _
Worksheets("RAPOR").Cells(k + 3, "t")) * 100) / _
Worksheets("RAPOR").Cells(k + 3, "e")
Worksheets("RAPOR").Cells(k + 3, "w") = CDbl(FormatNumber(oran, 2)) * 1
deg = deg + CDbl(FormatNumber(oran, 2)) * 1
yer = Worksheets("RAPOR").Cells(k + 3, "w")
k = k + 1
End If
i = i + 1
Loop
oran = Empty
Worksheets("RAPOR").Cells(k + 2, "w") = deg - yer
MsgBox "işlem tamam"
End Sub