求助 有些代码在个人宏标准模块不可以用，在工作表里就可以用

p1d1b1

我有一段代码，放在个人宏标准模块里面就老师出错，用不了，在工作表里就可以用，请前辈帮忙解惑，我是新人，不知说明白没有附上代码，

Option Explicit
Public sRng As String
Public sSqlRng As String
Public sFieldName As String
Sub 分工作簿()
    On Error Resume Next
    Dim oRecrodset
    Dim arr
    Dim sConStr As String
    Dim sSql As String
    Dim oWk As Worksheet
    Dim i As Integer
    Dim j As Integer
    Dim sfn As String
    Application.DisplayAlerts = False
    Application.DisplayAlerts = True
    sFieldName = ""
    Call xyf
    If Err.Number = 424 Then
        Exit Sub
    End If
    sConStr = "Provider='Microsoft.Jet.OLEDB.4.0';Data Source=" & ThisWorkbook.FullName & ";Extended Properties='Excel 8.0;HDR=YES'"
    sSql = "select distinct " & sFieldName & " from [" & sSqlRng & "] where  Not IsNull(" & sFieldName & ")"
    Set oRecrodset = CreateObject("ADODB.Recordset")
    With oRecrodset
        .Open sSql, sConStr
        arr = .getrows
        .Close
        Application.Evaluate(sRng).Copy
        For i = 0 To UBound(arr, 2)
            If Len(arr(0, i)) Then
                On Error GoTo solution
                sSql = "select * from [" & sSqlRng & "] where " & sFieldName & "='" & arr(0, i) & "'"
                .Open sSql, sConStr
                Set oWk = ThisWorkbook.Worksheets.Add(After:=ActiveSheet)
                oWk.Name = arr(0, i)
                For j = 1 To .Fields.Count
                    oWk.Cells(1, j) = .Fields(j - 1).Name
                Next
                oWk.Cells(2, 1).CopyFromRecordset oRecrodset
                oWk.[a1].CurrentRegion.PasteSpecial xlPasteFormats
                oWk.Columns.AutoFit
                .Close
            End If
        Next
        Application.CutCopyMode = False
    End With
    Set oRecrodset = Nothing
    Exit Sub
solution:
    MsgBox "你选择的字段不适合用来拆分总表，请重新选择!"
    Application.CutCopyMode = False
End Sub
Sub xyf()
    Dim oRng As Range
    Set oRng = Application.InputBox(prompt:="请你选择要根据哪个字段拆分销售汇总表?", Title:="拆分总表", Type:=8)
    sRng = oRng.CurrentRegion.Address(False, False, xlA1, True)
    sSqlRng = Mid(Replace(sRng, "!", "$", , 1), InStr(1, sRng, "]") + 1)
    If oRng.Columns.Count = 1 Then
        sFieldName = "[" & oRng.End(xlUp).Value & "]"
    End If
    Set oRng = Nothing
End Sub
Sub 分拆工作表()
    Dim sht As Worksheet
    Dim MyBook As Workbook
    Set MyBook = ActiveWorkbook
    For Each sht In MyBook.Sheets
        sht.Copy
        ActiveWorkbook.SaveAs Filename:=MyBook.Path & "\" & sht.Name, FileFormat:=xlNormal     '将工作簿另存为EXCEL默认格式
        ActiveWorkbook.Close
    Next
    MsgBox "文件已经被分拆完毕!"
End Sub