Makro Yavaş çalışması

[orcunkurtar]

Merhaba

dosya linki Ekteki dosyada E4 ve e5 sayafasında GETIR butonuna bastığımda eskiden 2 sn süren işlem şimdi 2 dakikada bitiyor . Yavaşlama sebebi ne olabilir ayrıca exceli kapadığımızda bir uyarı veriyor . Yardımcı olabilecek var mı

 

[Korhan Ayhan]

Bu şekilde bir deneyiniz.

Private Sub CommandButton1_Click()
    Zaman = Timer
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Range("G22:O10000").ClearContents
    ID = Range("E2")
    
    sonsatir = Sheets("E2").Cells(Rows.Count, "A").End(xlUp).Row
    
    For i = 2 To sonsatir
        dongu = Cells(Rows.Count, "G").End(3).Row + 1
        If Sheets("E2").Cells(i, 8) = ID Then
            Sheets("E4").Cells(dongu, 7) = Sheets("E2").Cells(i, 1)
            Sheets("E4").Cells(dongu, 8) = Sheets("E2").Cells(i, 2)
            Sheets("E4").Cells(dongu, 9) = Sheets("E2").Cells(i, 5)
            Sheets("E4").Cells(dongu, 10) = Sheets("E2").Cells(i, 6)
            Sheets("E4").Cells(dongu, 11) = Sheets("E2").Cells(i, 7)
            Sheets("E4").Cells(dongu, 12) = Sheets("E2").Cells(i, 9)
            Sheets("E4").Cells(dongu, 13) = Sheets("E2").Cells(i, 10)
            Sheets("E4").Cells(dongu, 14) = Sheets("E2").Cells(i, 13)
        End If
    Next i
    
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

    MsgBox "İşleminiz tamamlanmıştır." & vbCr & vbCr & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub

 

[orcunkurtar]

Bu şekilde bir deneyiniz.

Private Sub CommandButton1_Click()
    Zaman = Timer
   
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
   
    Range("G22:O10000").ClearContents
    ID = Range("E2")
   
    sonsatir = Sheets("E2").Cells(Rows.Count, "A").End(xlUp).Row
   
    For i = 2 To sonsatir
        dongu = Cells(Rows.Count, "G").End(3).Row + 1
        If Sheets("E2").Cells(i, 8) = ID Then
            Sheets("E4").Cells(dongu, 7) = Sheets("E2").Cells(i, 1)
            Sheets("E4").Cells(dongu, 8) = Sheets("E2").Cells(i, 2)
            Sheets("E4").Cells(dongu, 9) = Sheets("E2").Cells(i, 5)
            Sheets("E4").Cells(dongu, 10) = Sheets("E2").Cells(i, 6)
            Sheets("E4").Cells(dongu, 11) = Sheets("E2").Cells(i, 7)
            Sheets("E4").Cells(dongu, 12) = Sheets("E2").Cells(i, 9)
            Sheets("E4").Cells(dongu, 13) = Sheets("E2").Cells(i, 10)
            Sheets("E4").Cells(dongu, 14) = Sheets("E2").Cells(i, 13)
        End If
    Next i
   
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True

    MsgBox "İşleminiz tamamlanmıştır." & vbCr & vbCr & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub

Çok teşekkür ederim.