kaydet butonunda aktif hücre seçimi çok yavaş

[newversion]

Sub Kaydet()
Set s1 = Sheets("Form") 'Form'u s1 olarak tanımla
Set s2 = s1.[H11] 'yazi sayfasının H11 hücresini s2 olarak tanımla
Sheets(s2.Text).Select 's2'yi seç
Range("A1").Select 'a1 hücresini seç
Do While Not IsEmpty(ActiveCell) 'Aktif hücre boş oluncaya kadar
ActiveCell.Offset(1, 0).Select 'bir alt hücreyi
Loop 'seç
ActiveCell.Value = s1.Range("H7") 'Aktif boş hücreye Sayfa1'deki H7 hücresini yaz
ActiveCell.Offset(0, 1).Value = s1.Range("H8") 'Aktif hücrenin 1 sağ hücresinne H8 hücresini yaz
ActiveCell.Offset(0, 2).Value = s1.Range("H4") 'Aktif hücrenin 2 sağ hücresinne H4 hücresini yaz
ActiveCell.Offset(0, 3).Value = s1.Range("H3") 'Aktif hücrenin 3 sağ hücresinne H3 hücresini yaz
ActiveCell.Offset(0, 4).Value = s1.Range("H6") 'Aktif hücrenin 4 sağ hücresinne H6 hücresini yaz
ActiveCell.Offset(0, 5).Value = s1.Range("H9") 'Aktif hücrenin 5 sağ hücresinne H9 hücresini yaz
ActiveCell.Offset(0, 6).Value = s1.Range("H10") 'Aktif hücrenin 6 sağ hücresinne H10 hücresini yaz
MsgBox "Kayıt tamam Ağabey" 'Uyarı mesajı ver
Set s1 = Nothing 'Sayfa tanımlamalarını kaldır.
Set s2 = Nothing 'Sayfa tanımlamalarını kaldır.
End Sub
Sub sil()
Range("D8").ClearContents 'D8 hücresinin içeriğini sil
Range("D10").ClearContents 'D10 hücresinin içeriğini sil
Range("D12").ClearContents 'D12 hücresinin içeriğini sil
Range("D14").ClearContents 'D14 hücresinin içeriğini sil

End Sub
Kaydet butonumda yukarıdaki kodlar mevcut ve çalışıyor.Ancak aktif hücre seçimi (malum daha önce kaydettiğim 5400 satırlık veriyi tarayıp boş A1 hücresi aradığından)çok yavaş oluyor.Verimizi son satıra yazdırmanın daha çabuk bir yolu yok mu?

 

[Levent Menteşoğlu]

Boş satırı bulmanın bir çok yolu var siz en uzun olanını seçmişsiniz. Aşağıdaki gibi deneyin.

Sub Kaydet()
Set s1 = Sheets("Form") 'Form'u s1 olarak tanımla
Set s2 = s1.[H11] 'yazi sayfasının H11 hücresini s2 olarak tanımla
Sheets(s2.Text).Select 's2'yi seç
 
[B][COLOR=blue]Range("a65536").end(3).offset(1,0).select[/COLOR][/B]
 
ActiveCell.Value = s1.Range("H7") 'Aktif boş hücreye Sayfa1'deki H7 hücresini yaz
ActiveCell.Offset(0, 1).Value = s1.Range("H8") 'Aktif hücrenin 1 sağ hücresinne H8 hücresini yaz
ActiveCell.Offset(0, 2).Value = s1.Range("H4") 'Aktif hücrenin 2 sağ hücresinne H4 hücresini yaz
ActiveCell.Offset(0, 3).Value = s1.Range("H3") 'Aktif hücrenin 3 sağ hücresinne H3 hücresini yaz
ActiveCell.Offset(0, 4).Value = s1.Range("H6") 'Aktif hücrenin 4 sağ hücresinne H6 hücresini yaz
ActiveCell.Offset(0, 5).Value = s1.Range("H9") 'Aktif hücrenin 5 sağ hücresinne H9 hücresini yaz
ActiveCell.Offset(0, 6).Value = s1.Range("H10") 'Aktif hücrenin 6 sağ hücresinne H10 hücresini yaz
MsgBox "Kayıt tamam Ağabey" 'Uyarı mesajı ver
Set s1 = Nothing 'Sayfa tanımlamalarını kaldır.
Set s2 = Nothing 'Sayfa tanımlamalarını kaldır.
End Sub
Sub sil()
Range("D8").ClearContents 'D8 hücresinin içeriğini sil
Range("D10").ClearContents 'D10 hücresinin içeriğini sil
Range("D12").ClearContents 'D12 hücresinin içeriğini sil
Range("D14").ClearContents 'D14 hücresinin içeriğini sil
End Sub

 

[newversion]

harika.çok teşekkür ederim Levent bey.Bu kadar kısa sürede kaydedeceğini ummamıştım.

 

[newversion]

Emeğinize ve elinize sağlık.

 

[Levent Menteşoğlu]

Rica ederim. Birde aşağıdaki satırda gereksiz oluyor, onuda kod içinden silebilirsiniz.

Range("A1").Select 'a1 hücresini seç