A dan K ya kadar satırları ay sayısı kadar çoğaltıp L sütununu/30*Aylara bölerek diğer sayfaya getirme

[nazifdural]

Merhabalar
1- Çalışma Günleri Sayfasında A Sütunundan K Sütununa kadar, M Sütunundan X Sütununa kadar giden ay sütunları kadar alt alta kopyalayacak.M den X sütununa kadar olan değerleri Düzenleme Sayfasına M ve N Sütununa alt alta getirecek. Fakat Ay sütunlarındaki değeri sıfır olanları getirmeyecek.
2- Çalışma Günleri Sayfasında L Sütunundaki değeri de(Maaş) 30 Sayısına Bölüp, Ay sütunlarındaki değerle çarparak Düzenleme Sayfasındaki L sütununa getirecek.
İki gündür yüzlerce çalışma inceledim.Malesef buna uygun bulamadım.
Acil Yardımlarınızı bekliyorum.
Örneğim Ektedir.
Bunu Vba - Makro ile yapmak istiyorum.

 

[veyselemre]

Sub listele()
    Set sC = Sheets("CALISMA GUNLERI")
    Set sD = Sheets("DUZENLEME")
    sC.Select
    sat = 2
    For i = 2 To Cells(Rows.Count, 1).End(3).Row
        For ii = 13 To 24
            gun = Cells(i, ii)
            If gun > 0 Then

                sD.Cells(sat, 1).Resize(, 11).Value = Cells(i, 1).Resize(, 11).Value
                
                If gun = 30 Then
                    sD.Cells(sat, "L") = Cells(i, "L")
                Else
                    sD.Cells(sat, "L") = Round(Cells(i, "L") / 30 * gun, 2)
                End If
                
                sD.Cells(sat, "M") = ii - 12
                sD.Cells(sat, "N") = gun
                
                sat = sat + 1
            End If
        Next ii
    Next i
   sD.Select
End Sub

 

[nazifdural]

Sub listele()
    Set sC = Sheets("CALISMA GUNLERI")
    Set sD = Sheets("DUZENLEME")
    sC.Select
    sat = 2
    For i = 2 To Cells(Rows.Count, 1).End(3).Row
        For ii = 13 To 24
            gun = Cells(i, ii)
            If gun > 0 Then

                sD.Cells(sat, 1).Resize(, 11).Value = Cells(i, 1).Resize(, 11).Value
               
                If gun = 30 Then
                    sD.Cells(sat, "L") = Cells(i, "L")
                Else
                    sD.Cells(sat, "L") = Round(Cells(i, "L") / 30 * gun, 2)
                End If
               
                sD.Cells(sat, "M") = ii - 12
                sD.Cells(sat, "N") = gun
               
                sat = sat + 1
            End If
        Next ii
    Next i
   sD.Select
End Sub

malesef çalışmadı

 

[veyselemre]

O kadar kod denenmeden yazılmaz, ekteki dosyanızı inceleyin.

 

[nazifdural]

O kadar kod denenmeden yazılmaz, ekteki dosyanızı inceleyin.

Ellerinize sağlık.Çok güzel olmuş.