求老师看看，能不能加些释放内存的代码或者简化一下程序？

lhj1861

求老师帮忙看看，程序没问题实现的功能很简单，就是把B列非空的行在A列都付给公式，我的数据有700多条，以后人员会一直增加，因为加了这张表其他表的运行都受影响了，不知道怎么优化代码，或者释放内存什么的？
Sub 处理()

Dim a1 As Integer, r As Integer, i As Integer, m As String
r = 1
   Application.ScreenUpdating = False
    Worksheets("花名册").Activate
   With Sheets("花名册")
         a1 = .Range("B65536").End(xlUp).Row
'------------------------以下代码实现把B列有内容的行在A列都复制公式
    .Range("A2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(ISERROR(VLOOKUP(INDIRECT(""$B$2:$B$1000""),INDIRECT(""人员信息!$C$3:$D$200""),2,FALSE)),"""",VLOOKUP(INDIRECT(""$B$2:$B$1000""),INDIRECT(""人员信息!$C$3:$D$200""),2,FALSE))"
    Selection.AutoFill Destination:=.Range("A2", "A" & a1), Type:=xlFillCopy
    .Range("A2", "A" & a1).Select
'------------------------以下代码实现把A列升序排列'
    .Columns("A:A").Select
    .Range("A1", "J" & a1).Sort Key1:=.Range("A1"), Order1:=xlAscending, Header:= _
    xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    SortMethod:=xlPinYin, DataOption1:=xlSortNormal
'------------------------以下代码实现把A列第2行开始公式值为空的行删除  Formula
    Application.ScreenUpdating = False
        For i = 2 To a1
            m = .Range("a" & i)
             If m = "" Then
                '.Rows(r).Delete
                r = r + 1
             Else
                Exit For
             End If
        Next i
         .Rows("2" & ":" & r).Select
         Selection.Delete Shift:=xlUp
    End With
    Application.ScreenUpdating = True

End Sub