Yavaş Çalışan Makro

[1Al2Ver]

Merhaba,

Laptop'umda, Win10 ve Ofis-365 kullanıyorum,

İş Yeri bilgisayımda ise Win7 ve Ofis-2010 kullanıyorum,

Ek'li dosyamdaki makro, laptopta 15-20 saniye de aktarma yaparken,

Win7 ve Ofis-2010 kullanılan bilgisayarda, aktarma işlemini 13 dakika da aktardı,

Olası sebebi ne olabilir ve çözüm nedir ?

Teşekkür ederim.

 

[Ziynettin]

Bu şekilde deneyin.

Sub fatura_test()
Dim s1 As Worksheet, s2 As Worksheet
Set s1 = Sheets("FATURA_KAYIT")
Set s2 = Sheets("ÖDENMİŞ_FATURA_BORÇLARI")
tarih = CDate(s1.[C2])
ay1 = s1.[C21]: ay2 = s1.[C22]: ay3 = s1.[C23]: ay4 = s1.[C24]
toplam = s1.[C25]: ortalama = s1.[C26]
a = s1.[A3:X20].Value
ReDim b(1 To UBound(a), 1 To 31)
For i = 1 To UBound(a)
say = say + 1
b(say, 1) = a(i, 1): b(say, 2) = tarih: b(say, 3) = a(i, 3)
b(say, 4) = a(i, 2): b(say, 5) = ay1
For j = 1 To 14: b(say, j + 5) = a(i, j + 3): Next j
b(say, 20) = ay2: b(say, 21) = ay3: b(say, 22) = ay4
b(say, 23) = toplam: b(say, 24) = ortalama
For j = 1 To 7: b(say, j + 24) = a(i, j + 17): Next j
Next i
If say > 0 Then
    son = s2.Cells(Rows.Count, 1).End(3).Row + 1
    s2.Range("A" & son).Resize(say, 31) = b
    soru = "Aktarma Tamamlandı, Kayıtları Silmek İstiyor musunuz?"
    cevap = MsgBox(soru, vbYesNo + vbQuestion)
    Select Case cevap
        Case vbYes
            s1.Range("C2,C21:C24,C26,D3:Q20").ClearContents
        Case vbNo
            Exit Sub
    End Select
End If
End Sub

 

[1Al2Ver]

Sayın Ziynettin merhaba,

Kod için teşekkür ederim, sorunsuz çalışıyor.

Merakımı bağışlayın, bendeki kod, Win7 ve Ofis-2010 da, neden bu kadar uzun zamanda aktarma yapıyordu ?

Tekrar teşekkür ederim,

Saygılarımla.