• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Soru fonksiyon yavaşlığı

Deneyiniz.

Kod aşağıdaki işlemlerde devreye girmektedir.

1-31 arası sayfalar aktif olduğunda
1-31 arası sayfalarda hücre değiştiğinde
1-31 arası sayfalarda hücre seçimi değiştiğinde
Veri isimli sayfa aktif olduğunda

Sanırım otomasyon için yeterli olacaktır.
 

Ekli dosyalar

Bu sefer muhteşem hocam. Sayfamda bir ÇOĞALT butonu var buna yeni kod atamışsınız

Sub Sayfa_Kopyala()
Sheets("1").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = Sheets.Count - 2
Range("P1") = DateSerial(Year(Date), 12, ActiveSheet.Name)
End Sub

Benim eski kodum

Sub cogalt()
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For k = 1 To Application.Sheets.Count
If IsNumeric(Sheets(k).Name) Then
sayisal = sayisal + 1
Else
harf = harf + 1
End If
Next k
Tespit = InputBox("Çoğaltılacak gün sayısını giriniz", "UFUK")
For i = sayisal To Tespit + sayisal - 1
Sheets(CStr(sayisal)).Select
Sheets(CStr(sayisal)).Copy Before:=Sheets(1)
Sheets(1).Name = i + 1
Sheets(1).Range("p1") = Sheets("1").Range("p1") + i
Sheets(1).Range("L14,D3:F32,J3:Q32,D36:F65,J36:Q65,D69:F98,J69:Q98,D101:F130,J101:Q130,D134:F163,J134:Q163").ClearContents
If numlock = True Then CreateObject("Wscript.Shell").SendKeys "{NUMLOCK}"
Next i
For j = 1 To Application.Sheets.Count - harf
On Error Resume Next
Sheets(CStr(j)).Select
Sheets(CStr(j)).Move Before:=Sheets(j)
Next j
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub


Burada çoğalttığı sayfayı ayriyeten temizliyordu şimdi sizdeki kodla temizlemedi. Bunu nasıl yaparız?
 
Siz o bölümde eski kodunuzu kullanabilirsiniz. Ben sayfayı çoğaltıp hız testi yapmak için o kodu yazmıştım.
 
Geri
Üst