kod yavaş çalışıyor

[igultekin2000]

iyi günler; makro kayıt yöntemiyle kaydettiğim makro önceleri daha iyi çalışıyordu şimdi yavaşladı, acaba gereksiz bir yer mi var.

Sub kayit()

    Sheets("SABLON").Select
    Range("A2:L2").Select
    Selection.Copy
    Sheets("ANAGİRİŞ").Select
    Application.Goto Reference:="R99999C1"
    ActiveCell.Offset(0, 1).Range("A1").Select
    Selection.End(xlUp).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveCell.Offset(1, 0).Range("C1").Select 'tarih sıralam
    Range("A2:R" & Rows.Count).Sort Key1:=Range("C1"), Order1:=xlAscending
    Sheets("SABLON").Select
    
    Application.CutCopyMode = False
    Sheets("GIRIS").Select
    Range("H2:K2").Select
    Selection.ClearContents
    Range("B2").Select
    
    
End Sub

 

[Ömer BARAN]

Merhaba.

Bir de aşağıdaki gibi dener misiniz?

İstediğiniz sonuç alınamıyorsa, kullandığınız kod içerisinde ve çalışır durumda olacak şekilde
ve işlemi açıklayıcı küçük bir not ekleyerek örnek belge yüklemeniz yerinde olur.
.

[B]Sub kayit()[/B]
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
Set ag = Sheets("ANAGİRİŞ"): Set s = Sheets("SABLON"): Set g = Sheets("GIRIS")
agsat = ag.Cells(Rows.Count, "B").End(xlUp).Row + 1
s.Range("A2:L2").Copy
ag.Cells(agsat, 2).PasteSpecial Paste:=xlPasteValues
ag.Range("A2:R" & Rows.Count).Sort Key1:=ag.Range("C1"), Order1:=xlAscending
g.Range("H2:K2").ClearContents
[COLOR="Red"]g.Activate: g.Range("B2").Activate[/COLOR]
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
[B]End Sub[/B]

 

[igultekin2000]

Sorunsuz çalışıyor

Merhaba.

Bir de aşağıdaki gibi dener misiniz?

İstediğiniz sonuç alınamıyorsa, kullandığınız kod içerisinde ve çalışır durumda olacak şekilde
ve işlemi açıklayıcı küçük bir not ekleyerek örnek belge yüklemeniz yerinde olur.
.

[B]Sub kayit()[/B]
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
Set ag = Sheets("ANAGİRİŞ"): Set s = Sheets("SABLON"): Set g = Sheets("GIRIS")
agsat = ag.Cells(Rows.Count, "B").End(xlUp).Row + 1
s.Range("A2:L2").Copy
ag.Cells(agsat, 2).PasteSpecial Paste:=xlPasteValues
ag.Range("A2:R" & Rows.Count).Sort Key1:=ag.Range("C1"), Order1:=xlAscending
g.Range("H2:K2").ClearContents
g.Activate: g.Range("B2").Activate
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
[B]End Sub[/B]

teşekkürler, kayıt hızı çok farketti, öyle ki kayıt ettiği anlaşılmıyor.

 

[Ömer BARAN]

Tekrar merhaba.

-- Kullanrığınız kodlarda, mümkün olduğunca .Select, .Activate, Application.Goto...gibi satırlar olmamasına özen gösteriniz.
-- Ayrıca verdiğim kodlardaki gibi .ScreenUpdating ve .Calculation satırlarını kullanmanız hızı asıl değiştirendir.
-- Hatta; önceki verdiğim kod'da kırmızı renklendirdiğim satırı da silebilirsiniz.
.

 

[igultekin2000]

ilginize teşekkürler, ilave soru.

Tekrar merhaba.

-- Kullanrığınız kodlarda, mümkün olduğunca .Select, .Activate, Application.Goto...gibi satırlar olmamasına özen gösteriniz.
-- Ayrıca verdiğim kodlardaki gibi .ScreenUpdating ve .Calculation satırlarını kullanmanız hızı asıl değiştirendir.
-- Hatta; önceki verdiğim kod'da kırmızı renklendirdiğim satırı da silebilirsiniz.
.

ilginize teşekkürler; gerçi buraya yazmam doğrumu bilmiyorum ama daha önce sizin yaptığınız excel formülü var, sordum ama izahı biraz karmaşık olduğundan tam sonuç alamadım. örnek dosyayı ekliyorum.