formul kopyalama

[igultekin2000]

iyi akşamlar;
K2 hücresine yazdığım formülü , makro ile son dolu satır boyunca aktarmak istiyorum. son dolu satır yapamadığım için K3:K500 yapıtığımda 500 satır boyunca formülü kopyalıyor.
kullandığım makro

Sub formul_kopyala()
'urun_detay sayfası
    
    Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
    On Error Resume Next
    Application.EnableEvents = False
    
    Range("K2").Copy
    Range("K3:K500").PasteSpecial Paste:=xlFormulas, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

    Application.EnableEvents = False
    Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic

End Sub

 

[Korhan Ayhan]

Deneyiniz.

Sub formul_kopyala()
'urun_detay sayfası
    
    Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
    On Error Resume Next
    Application.EnableEvents = False
    
    Son = Evaluate("=LOOKUP(2,1/(B3:B1048576<>""""),ROW(B3:B1048576))")
    
    Range("K2").Copy
    Range("K3:K" & Son).PasteSpecial Paste:=xlFormulas

    Application.EnableEvents = False
    Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic

End Sub

 

[igultekin2000]

sorunsuz çalışıyor

Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic

bu koduda daha önce siz yazmıştınız, çok işe yarıyor, yapılan işlemi son derece hızlandırıyor.

Son = Evaluate("=LOOKUP(2,1/(B3:B1048576<>""""),ROW(B3:B1048576))")

bu kodda benim için çok faydalı olacak. formül kopyalamayı muhasebede çalışmam hasebiyle çok kullanıyorum. Çok teşekkürler.