Aktarma Makrosunda Sadeleştirme

[1Al2Ver]

Merhaba,

Arkadaşlar aşağıdaki kodu daha sade nasıl düzenleye biliriz ?

Teşekkür ederim.

Sub Aylıka_Aktar()

Set s2 = Sheets("GÜNLÜK"): Set s3 = Sheets("AYLIK")
ilksatır = 4: sonsatır = s2.[B10].End(3).Row: tarih = s2.[B4]
For satır = ilksatır To sonsatır
s3satır = s3.[B65536].End(3).Row + 1

    s3.Cells(s3satır, 2) = tarih: s3.Cells(s3satır, 4) = s2.Cells(satır, 4)
    
    s3.Cells(s3satır, 3) = s2.Cells(satır, 3): s3.Cells(s3satır, 5) = s2.Cells(satır, 5)
    s3.Cells(s3satır, 6) = s2.Cells(satır, 6): s3.Cells(s3satır, 7) = s2.Cells(satır, 7)
    s3.Cells(s3satır, 8) = s2.Cells(satır, 8): s3.Cells(s3satır, 9) = s2.Cells(satır, 9)
    s3.Cells(s3satır, 10) = s2.Cells(satır, 10): s3.Cells(s3satır, 11) = s2.Cells(satır, 11)
    s3.Cells(s3satır, 12) = s2.Cells(satır, 12): s3.Cells(s3satır, 13) = s2.Cells(satır, 13)
    s3.Cells(s3satır, 14) = s2.Cells(satır, 14): s3.Cells(s3satır, 15) = s2.Cells(satır, 15)
    s3.Cells(s3satır, 16) = s2.Cells(satır, 16): s3.Cells(s3satır, 17) = s2.Cells(satır, 17)
    s3.Cells(s3satır, 18) = s2.Cells(satır, 18): s3.Cells(s3satır, 19) = s2.Cells(satır, 19)
    s3.Cells(s3satır, 20) = s2.Cells(satır, 20): s3.Cells(s3satır, 21) = s2.Cells(satır, 21)
    s3.Cells(s3satır, 22) = s2.Cells(satır, 22): s3.Cells(s3satır, 23) = s2.Cells(satır, 23)
    s3.Cells(s3satır, 24) = s2.Cells(satır, 24): s3.Cells(s3satır, 25) = s2.Cells(satır, 25)
    s3.Cells(s3satır, 26) = s2.Cells(satır, 26): s3.Cells(s3satır, 27) = s2.Cells(satır, 27)
    s3.Cells(s3satır, 28) = s2.Cells(satır, 28): s3.Cells(s3satır, 29) = s2.Cells(satır, 29)
    s3.Cells(s3satır, 30) = s2.Cells(satır, 30): s3.Cells(s3satır, 31) = s2.Cells(satır, 31)
    s3.Cells(s3satır, 32) = s2.Cells(satır, 32): s3.Cells(s3satır, 33) = s2.Cells(satır, 33)
    s3.Cells(s3satır, 34) = s2.Cells(satır, 34): s3.Cells(s3satır, 35) = s2.Cells(satır, 35)
    s3.Cells(s3satır, 36) = s2.Cells(satır, 36): s3.Cells(s3satır, 37) = s2.Cells(satır, 37)
    s3.Cells(s3satır, 38) = s2.Cells(satır, 38): s3.Cells(s3satır, 39) = s2.Cells(satır, 39)
    s3.Cells(s3satır, 40) = s2.Cells(satır, 40): s3.Cells(s3satır, 41) = s2.Cells(satır, 41)
    s3.Cells(s3satır, 42) = s2.Cells(satır, 42): s3.Cells(s3satır, 43) = s2.Cells(satır, 43)
    s3.Cells(s3satır, 44) = s2.Cells(satır, 44): s3.Cells(s3satır, 45) = s2.Cells(satır, 45)
    s3.Cells(s3satır, 46) = s2.Cells(satır, 46): s3.Cells(s3satır, 47) = s2.Cells(satır, 47)
    s3.Cells(s3satır, 48) = s2.Cells(satır, 48): s3.Cells(s3satır, 49) = s2.Cells(satır, 49)
    s3.Cells(s3satır, 50) = s2.Cells(satır, 50): s3.Cells(s3satır, 51) = s2.Cells(satır, 51)
    s3.Cells(s3satır, 52) = s2.Cells(satır, 52): s3.Cells(s3satır, 53) = s2.Cells(satır, 53)
    s3.Cells(s3satır, 54) = s2.Cells(satır, 54): s3.Cells(s3satır, 55) = s2.Cells(satır, 55)
    s3.Cells(s3satır, 56) = s2.Cells(satır, 56): s3.Cells(s3satır, 57) = s2.Cells(satır, 57)
    s3.Cells(s3satır, 58) = s2.Cells(satır, 58): s3.Cells(s3satır, 59) = s2.Cells(satır, 59)
    s3.Cells(s3satır, 60) = s2.Cells(satır, 60): s3.Cells(s3satır, 61) = s2.Cells(satır, 61)
        
Next



End Sub

 

[Korhan Ayhan]

Örnek dosya paylaşırsanız kod daha kısa yazılabilecek şekilde tasarlanabilir.

 

[1Al2Ver]

Sayın Korhan Ayhan merhaba,

İlginiz için teşekkür ederim, dosya çok uzun, en kısa zamanda örnek bir dosya hazırlayıp ekleyeceğim,

Saygılarımla.

 

[1Al2Ver]

Merhaba,

Örnek dosya ek'tedir,

Teşekkür ederim.

 

[Ömer]

Merhaba,

Görsel olarak kısaltmak için 3 ile 61 arasını döngüye alabilirsiniz.

Sub Aylıka_Aktar()

    Set s2 = Sheets("GÜNLÜK")
    Set s3 = Sheets("AYLIK")
    ilksatır = 4
    sonsatır = s2.[B10].End(3).Row
    tarih = s2.[B4]
    s3satır = s3.[B65536].End(3).Row + 1
    
    For satır = ilksatır To sonsatır
        
        s3.Cells(s3satır, 2) = tarih
        
        For i = 3 To 61
            s3.Cells(s3satır, i) = s2.Cells(satır, i)
        Next i
        s3satır = s3satır + 1
        
    Next

End Sub

Not: Ben cevaplarken dosya eklemişsiniz. Dosyanızı incelemeden yazmıştım. Hata varsa dönüş yaparsınız.

 

[1Al2Ver]

Sayın Ömer merhaba,

İlginiz ve çözüm için teşekkür ederim, sağ olun, kod sorunsuz çalışıyor,

Hesaplama yaparken hızını artırmak ve bir defada ekrana yazdırmak için kullanacağımız kodu hangi satırlar arasına yazmam gerekiyor ?

Sanırım ;

Application.ScreenUpdating = False ve Application.ScreenUpdating = True kodları bunu çöze bilir.

Bir kaç deneme yaptım ama emin olmak istiyorum.

Teşekkür ederim.

 

[Korhan Ayhan]

Deneyiniz.

Hız olarak daha iyi sonuç verecektir.

Option Explicit

Sub Aylik_Tabloya_Aktar()
    Dim S1 As Worksheet, S2 As Worksheet, Son As Long
    
    Set S1 = Sheets("GÜNLÜK")
    Set S2 = Sheets("AYLIK")
    
    Son = S1.Cells(S1.Rows.Count, 2).End(3).Row
    
    If Son > 3 Then
        S1.Range("B4:BI" & Son).Copy S2.Cells(S2.Rows.Count, 2).End(3)(2, 1)
        MsgBox "Aktarım tamamlanmıştır.", vbInformation
    Else
        MsgBox "Aktarılacak veri bulunamadı!", vbExclamation
    End If

    Set S1 = Nothing
    Set S2 = Nothing
End Sub

 

[1Al2Ver]

Sayın Korhan Ayhan merhaba,

İlginiz ve alternatif çözüm için teşekkür ederim, sağ olun.

Saygılarımla.