Soru Makro yavaş çalışıyor.

[burhancavus61]

Aşağıdaki Makro ile sadece istediğim sayfaları C8 hücresine alıyorum. Fakat makro 15 sn civarında işlem görüyor.
Çalışma kitabımda bişeylerimi çalıştırıyor acaba yoksa makro çokmu şişkin. Kitap içinde sayfa biraz fazla mecbur bu sayfaları gizliyorum.
Daha önce örnek kullandığım kitaplarda çalışması uzun sürmüyordu. Sağolsun yine burada üstadlar sayesnde bu kodu edinmiştim. Fikrinizi alabilirmiyim.

Private Sub Workbook_NewSheet(ByVal Sh As Object)
    VeriDogrulama
End Sub
Private Sub Workbook_SheetBeforeDelete(ByVal Sh As Object)
    VeriDogrulama
End Sub
Sub VeriDogrulama()
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Dim Sayfa As Worksheet
    For Each Sayfa In ThisWorkbook.Worksheets
        Sayfa.Name = Replace(Sayfa.Name, " ", "")
    Next

    Sheets("Bildirge_Giriş_Bilgileri").Select
    ActiveSheet.Unprotect

    Dim Sh  As Worksheet, _
        Syf As String
    
    For Each Sh In Worksheets
    
        If Not Sh.Name = "Sabitler" And Not Sh.Name = "SGK_İşyeri_Bilgileri" And Not Sh.Name = "Bildirge_Giriş_Bilgileri" And Not Sh.Name = "SGK_İCMAL" And Not Sh.Name = "Ödemeler_Giriş" And Not Sh.Name = "Kontrol" And Not Sh.Name = "Bildirge" And Not Sh.Name = "Personel_Listesi" And Not Sh.Name = "MUHTASAR" And Not Sh.Name = "Maaş_Verileri" And Not Sh.Name = "ÖZEL_YAPIŞTIR" And Not Sh.Name = "Çıkış_Nedenleri" And Not Sh.Name = "Eksik_Gün_Nedenleri" And Not Sh.Name = "Belge_Türleri" And Not Sh.Name = "İş_Kolu_Kodu_Listesi" And Not Sh.Name = "Meslek_Kodları" Then
            If Syf = "" Then
                Syf = Sh.Name
            Else
                Syf = Syf & "," & Sh.Name
            End If
        End If
        
    Next Sh
    
    With Sheets("Bildirge_Giriş_Bilgileri").Range("C8").Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:=Syf
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
    
    Sheets("Bildirge_Giriş_Bilgileri").Select
    ActiveSheet.Protect
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    MsgBox "MUHTASAR Beyanname için taşınan sayfalar güncellendi...", vbInformation

End Sub

 

[Ömer]

Merhaba,

Konu içeriğini incelemek gerekir.

Şimdilik kodların;
başına:

Application.Calculation = xlManual


sonuna:

Application.Calculation = xlAutomatic

ekleyerek deneyiniz.

.

 

[burhancavus61]

Harikasınız hocam 2 sn sürmedi teşekkür ederim.