Kod Hızlandırma

[ERENYILMAZ]

Formdaki örneklerden faydalanarak Aşağıdaki kodları geliştirip veri girişi yapmaktayım. Kaydettiğim veriler sürekli artmakta (Yaklaşık 2000) kodlarda buna bağlı olarak yavaşlamaktadır.
Aşağıda eklemiş olduğum kodları daha hızlı hale getirmek mümkün mü? Bu konuda fazla bilgi sahibi değilim.Hocalarımızın görüşlerini ve bu konuda yardımlarını bekliyorum. Saygılarımla.

Private Sub CommandButton1_Click()
Application.EnableEvents = False
Application.ScreenUpdating = False
If ComboBox1.Text = "" Then MsgBox "TARİH Girmeniz gerekiyor": Exit Sub
If ComboBox2.Text = "" Then MsgBox "KOD girmeniz gerekiyor": Exit Sub
If ComboBox5.Text = "" Then MsgBox "ÖDEME ŞEKLİ girmeniz gerekiyor": Exit Sub
If ComboBox6.Text = "" Then MsgBox "TUTAR Girmeniz gerekiyor": Exit Sub
If MsgBox("Kayıt yapılacaktır onaylıyor musunuz ?", vbCritical + vbYesNo, "Hüseyin DURUKAN") = vbYes Then
ListBox1.RowSource = Empty
On Error Resume Next
Son_Dolu_Satir = Sheets("Sayfa2").Range("A65536").End(xlUp).Row
Bos_Satir = Son_Dolu_Satir + 1
Cells(Bos_Satir, "A") = ComboBox1.Text
Cells(Bos_Satir, "B") = ComboBox2.Text
Cells(Bos_Satir, "C") = ComboBox3.Text
Cells(Bos_Satir, "F") = ComboBox5.Text
Cells(Bos_Satir, "H") = CDbl(ComboBox6)
'ActiveWorkbook.Save
MsgBox "Kayıt işlemi tamamlanmıştır.", vbInformation, "Hüseyin DURUKAN"
Else
MsgBox "Kayıt işlemi iptal edilmiştir.", vbInformation, "Hüseyin DURUKAN"
End If
With UserForm3.ListBox1
.ColumnHeads = True
.ColumnCount = 7
.ColumnWidths = "90;70,235,0,0,90,0,90"
If Sheets("Sayfa2").Range("A6") = Empty Then
.RowSource = Empty
Else
.RowSource = "Sayfa2!A5:H" & [Sayfa2!A65536].End(3).Row
End If
End With
Call temiz
Application.EnableEvents = True
Application.ScreenUpdating = True
UserForm_Initialize
End Sub


Private Sub UserForm_Initialize()
baglan
With UserForm3.ListBox1
.ColumnHeads = True
.ColumnCount = 8
.ColumnWidths = "90;70,230,0,0,90,0,90"
ListBox1.RowSource = "Sayfa2!A5:H" & Sheets("Sayfa2").[a65536].End(xlUp).Row
End With
ComboBox1.SetFocus
With ComboBox5
.AddItem "Nakit"
.AddItem "Kredi Kartı"
.AddItem "Çek"
.AddItem "Senet"
End With
Calendar1.Visible = False
Calendar1.Value = Date
Label10.Caption = ComboBox3
End Sub

Sub baglan()
Set con = CreateObject("adodb.connection")
con.Open "provider=microsoft.jet.oledb.4.0;data source=" & ThisWorkbook.FullName & ";" & _
"extended properties=""excel 8.0;hdr=yes"""
End Sub