哪位大神帮我看下，下面这个代码运行很卡，还经常死机，要怎么改进。

z62316086

Sub 保存()
Application.ScreenUpdating = False
On Error GoTo 100
    Dim es As Range, a%
   If Sheet3.[b:b].Find([k2]) = [k2] Then
    MsgBox "已经保存过了!"
   Else
100:
    Set es = Range("b65536").End(3)

a = Application.CountA(Sheet3.[a:a])
b = Application.CountA(Sheet4.[a:a])
c = Application.CountA(Sheet7.[a:a])
    If es.Row = 8 Then MsgBox "您还没有录入数据!请从B9格开始录入": End
    If [c3] = "" Then MsgBox "请输入客户名称!": Exit Sub
    If [h2] = "" Then MsgBox "请选择付款方式!": Exit Sub
    If [i9] = "" Then MsgBox "您还没有录入数据!请检查,数据未完整!": Exit Sub
    If [h2] = "对公账户" And [c5] = "" Then MsgBox "请在备注输入转入公司": Exit Sub
    If Application.CountIf([i9:i56], "<>") <> (es.Row - 8) Then MsgBox "请检查,数据未完整!": Exit Sub


    Range([b9], es.Offset(0, 16)).Select
    Selection.Copy
    Sheet3.Cells(a + 1, 4).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Sheet3.Cells(a + 1, "b").Resize(es.Row - 8) = [k2].Value '保存销售单号
    Sheet3.Cells(a + 1, "c").Resize(es.Row - 8) = [c3].Value '保存客户名称
Sheet3.Cells(a + 1, "a").Resize(es.Row - 8) = [c2].Value '保存开单日期
Sheet3.Cells(a + 1, "u").Resize(es.Row - 8) = [h2].Value '保存付款方式
Sheet3.Cells(a + 1, "v").Resize(es.Row - 8) = [k3].Value '保存联系人
Sheet3.Cells(a + 1, "w").Resize(es.Row - 8) = [p3].Value '保存手机
Sheet3.Cells(a + 1, "x").Resize(es.Row - 8) = [c4].Value '保存地址
Sheet3.Cells(a + 1, "y").Resize(es.Row - 8) = [c5].Value '保存备注
Sheet3.Cells(a + 1, "aa").Resize(es.Row - 8) = Now()  '保存登记账单日期
Sheet4.Cells(b + 1, "a") = [c2].Value  '保存登记账单日期
Sheet4.Cells(b + 1, "b") = [k2].Value '保存账单销售单号
Sheet4.Cells(b + 1, "c") = [c3].Value '保存账单客户名称
Sheet4.Cells(b + 1, "d") = [g6].Value '保存账单卷
Sheet4.Cells(b + 1, "e") = [c6].Value '保存账单米
Sheet4.Cells(b + 1, "f") = [k6].Value '保存账单金额
Sheet4.Cells(b + 1, "h") = [h2].Value '保存账单支付情况
Sheet4.Cells(b + 1, "m") = [c5].Value '保存账单备注
Sheet4.Cells(b + 1, "n") = Now() '保存开单日期
If [h2] = "对公账户" Then
Sheet7.Cells(c + 1, "a") = [c2].Value  '保存登记账单日期
Sheet7.Cells(c + 1, "b") = [k2].Value '保存账单销售单号
Sheet7.Cells(c + 1, "c") = [c3].Value '保存账单客户名称
Sheet7.Cells(c + 1, "e") = [c5].Value '保存账单备注

End If


    MsgBox "保存成功!"
   End If
   ActiveWindow.SmallScroll Down:=-100
   Range("c3").Select
   Application.ScreenUpdating = True

End Sub

哪位大神帮我看下，这个代码运行很卡，还经常死机，要怎么改进。

p4607596

没有附近,,大虾不会出现的..