以下我写的VBA代码执行到红色的那句就出现错误提示，无法运行，请求您的帮助

Sub 过上年帐册()
Dim LuJin As Variant
If Workbooks("GZ.xls").Sheets("CK").Cells(2, 19) = "☆" Then
MsgBox "您已经记过帐,，请勿重复！！"
Else
Application.Run "GZ.xls!源路径"
LuJin = Workbooks("GZ.xls").Sheets("CK").Cells(2, 20)
If LuJin = "" Then
MsgBox "源帐册路径/文件名未填写，程序将退出运行！"
Else
Application.ScreenUpdating = False '关闭屏幕更新
L = 1: 过材料库帐册: 过成品库帐册: 过样品库帐册       '
'删除空行
 Workbooks("GZ.xls").Sheets("CK").Cells(2, 19) = "☆"
  ActiveSheet.Protect红色
  ActiveWorkbook.Save
 End If
 End If
 Application.ScreenUpdating = True '屏幕更新
End Sub

Sub 过材料库帐册()
Dim Y As Long
Dim LuJin, Sql, Sq2, Conn As Variant
LuJin = Workbooks("GZ.xls").Sheets("CK").Cells(2, 20)
Y = [B65536].End(xlUp).Row + 1
ActiveSheet.Unprotect               '撤消当前工作表保护
Range("A5:L" & Y).ClearContents
Set Conn = CreateObject("adodb.connection")         '（1）设置对象
For n = 1 To 40
w = [D65536].End(xlUp).Row + 2
Conn.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & LuJin & "/" & "A" & n & ".xls"                                   'ThisWorkbook.Path指当前路径下的工作簿
Sql = "select *  from [A" & n & "$B5:F260" & "]"
Sq2 = "select *  from [A" & n & "$CM5:CO260" & "]"
Range("D" & w & ":" & " H65536").CopyFromRecordset Conn.Execute(Sql)  '将数据源A1到A40的的B/C列复制到D和E列
Range("I" & w & ":" & " K65536").CopyFromRecordset Conn.Execute(Sq2)
m = [D65536].End(xlUp).Row + 1
Range("B" & w & ":B" & m) = "A" & n
Conn.Close                                      '关闭链接
Next n
Set Conn = Nothing  '释放对象变量
End Sub

Sub 删除空行()
Dim m As String
Sheets("CK").Select
q = 5
    Do While Not (IsEmpty(Sheets(ActiveSheet.Name).Cells(q, 6).Value))
    q = q + 1
    Loop
    t = q - 1
For x = 5 To t
m = Round(Cells(x, 6), 2)
If m = 0 Then
  Range(Cells(x, 1), Cells(x, 12)).Select
    Selection.Delete Shift:=xlUp
    x = x - 1
    t = t - 1
    Else
    End If
    If x = t Then
    Exit For
    End If
    Next x
     ActiveWorkbook.Save
End Sub

Sub 过成品库帐册()
Dim Y As Long
Dim LuJin, Sql, Sq2, Conn As Variant
LuJin = Workbooks("GZ.xls").Sheets("CK").Cells(2, 20)
Y = [B65536].End(xlUp).Row + 1
ActiveSheet.Unprotect               '撤消当前工作表保护
Range("A5:L" & Y).ClearContents
Set Conn = CreateObject("adodb.connection")         '（1）设置对象
For n = 1 To 40
w = [D65536].End(xlUp).Row + 2
Conn.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & LuJin & "/" & "B" & n & ".xls"                                     'ThisWorkbook.Path指当前路径下的工作簿
Sql = "select *  from [B" & n & "$B5:F260" & "]"
Sq2 = "select *  from [B" & n & "$CM5:CO260" & "]"
Range("D" & w & ":" & " H65536").CopyFromRecordset Conn.Execute(Sql)
Range("I" & w & ":" & " K65536").CopyFromRecordset Conn.Execute(Sq2)
m = [D65536].End(xlUp).Row + 1
Range("B" & w & ":B" & m) = "B" & n
Conn.Close                                      '关闭链接
Next n
Set Conn = Nothing  '释放对象变量
End Sub

Sub 过样品库帐册()
Dim Y As Long
Dim LuJin, Sql, Sq2, Conn As Variant
LuJin = Workbooks("GZ.xls").Sheets("CK").Cells(2, 20)
Y = [B65536].End(xlUp).Row + 1
Range("A5:L" & Y).ClearContents
Set Conn = CreateObject("adodb.connection")         '（1）设置对象
For n = 1 To 20
w = [D65536].End(xlUp).Row + 2
Conn.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & LuJin & "/" & "C" & n & ".xls"                                     'ThisWorkbook.Path指当前路径下的工作簿
Sql = "select *  from [C" & n & "$B5:F260" & "]"
Sq2 = "select *  from [C" & n & "$CM5:CO260" & "]"
Range("D" & w & ":" & " H65536").CopyFromRecordset Conn.Execute(Sql)
Range("I" & w & ":" & " K65536").CopyFromRecordset Conn.Execute(Sq2)
m = [D65536].End(xlUp).Row + 1
Range("B" & w & ":B" & m) = "C" & n
Conn.Close                                      '关闭链接
Next n
Set Conn = Nothing  '释放对象变量
End Sub