Veri Aktarmada Makro sorunu

[omeryılmaz]

Merhaba Arkadaşlar....
Kurumumuzda kullanılmak üzere Demirbaş kayıtlarını tabipler bazında listelemek için oluşturduğum, Makro ile çalıştırdığım formatı tam istediğim gibi düzenleyemedim. Konu ile ilgili ayrıntılı bilgi Sayfa üzerinde mevcuttur.

Konuyla İlgileneceklere şimdiden şükranlarımı sunuyorum..

 

[halit3]

Sarf sayfasında bu kodu çalıştırıp denermisiniz.

Sub RaporSarf()
Worksheets("Sarf").Range("A3:Y65536").ClearContents
Worksheets("Sarf").Range("A3:Y65536").Interior.ColorIndex = xlNone
Worksheets("Sarf").Range("A3:Y65536").Font.ColorIndex = 0
sat = 3
deg1 = 3
deg2 = 1
For r = 5 To Worksheets("Rapor").[a65536].End(3).Row
aranan1 = Sheets("Rapor").Cells(r, 24).Value
If WorksheetFunction.CountIf(Worksheets("Rapor").Range("x5:x" & r), aranan1) = 1 Then
Sheets("Sarf").Cells(sat, 1).Value = "AİLE HEKİMİ ADI   :" & Sheets("Rapor").Cells(r, 22).Value & Sheets("Rapor").Cells(r, 23).Value & Sheets("Rapor").Cells(r, 24).Value
Sheets("Sarf").Cells(sat, 1).Font.ColorIndex = 3
Sheets("Sarf").Cells(sat, 2).Font.ColorIndex = 3

sat = sat + 1
For t = 1 To 24
Sheets("Sarf").Cells(sat, t).Value = Sheets("Rapor").Cells(4, t).Value
Next
sat = sat + 1
For i = 5 To Worksheets("Rapor").[a65536].End(3).Row
aranan2 = Sheets("Rapor").Cells(i, 24).Value
If aranan2 = aranan1 Then
For t = 1 To 24
If t = 23 Then
Sheets("Sarf").Cells(sat, t).Value = Sheets("Rapor").Cells(r, 23).Value
Else
Sheets("Sarf").Cells(sat, t).Value = Sheets("Rapor").Cells(i, t).Value
End If
Next
sat = sat + 1
End If
Next
Sheets("Sarf").Cells(sat, 1).Value = "TOPLAM"
deg2 = deg2 + 1
For j = 6 To 20
Sheets("Sarf").Cells(sat, j).Value = WorksheetFunction.Sum(Worksheets("Sarf").Range(Cells(deg1, j), Cells(sat - 1, j)))
If Sheets("Sarf").Cells(sat, j).Value = 0 Then
Sheets("Sarf").Cells(sat, j).Value = ""
End If
Next j
Sheets("Sarf").Cells(sat, 2).Value = WorksheetFunction.Sum(Worksheets("Sarf").Range(Cells(sat, 6), Cells(sat, 20)))
For n = 1 To 24
Sheets("Sarf").Cells(sat, n).Interior.ColorIndex = 8
Next n
sat = sat + 2
deg1 = sat
End If
Next r
MsgBox "Toplam  " & r & "  adet değişken var"
MsgBox "Toplam  " & deg2 - 1 & "  adet müşteri aktrımı yapıldı"
MsgBox "Toplam  " & sat - 1 & "  satır aktrım yapıldı"
'Sheets("Rapor").Columns("W:W").ClearContents
End Sub

 

[omeryılmaz]

Hocam İlginiz için şükranlarımı sunuyorum...

Makroda Sarf Sayfasında Alt Toplamları almıyor....

Sheets("Sarf").Cells(sat, j).Value = WorksheetFunction.Sum(Worksheets("Sarf").Range(Cells(deg1, j), Cells(sat - 1, j)))

hatası

 

[halit3]

Hocam İlginiz için şükranlarımı sunuyorum...

Makroda Sarf Sayfasında Alt Toplamları almıyor....

Sheets("Sarf").Cells(sat, j).Value = WorksheetFunction.Sum(Worksheets("Sarf").Range(Cells(deg1, j), Cells(sat - 1, j)))

hatası

Dosyanızdaki mavi renkli satırlarda toplamlar alınmaktadır.

 

[omeryılmaz]

Hocam Teşekkürler
Eline yüreğine Sağlık....

 

[halit3]

Hocam Teşekkürler
Eline yüreğine Sağlık....

İyi çalışmalar