VBA代码 哪错了运行错误，请老师帮忙

yaozhaoze

Sub 宏1()
Application.ScreenUpdating = False
    Rows("2:10000").Select
    Range("A10000").Activate
    ActiveWorkbook.Worksheets("包装明细").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("包装明细").Sort.SortFields.Add2 Key:=Range("B2:B10000"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("包装明细").Sort.SortFields.Add2 Key:=Range("J2:J10000"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("包装明细").Sort.SortFields.Add2 Key:=Range("M2:M10000"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("包装明细").Sort
        .SetRange Range("A1:T10000")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
   Rows("1:1").Select
    Range("H1").Activate
    Selection.AutoFilter
   ActiveSheet.Range("$A$1:$T$10000").AutoFilter Field:=19, Criteria1:="<>*/*", _
        Operator:=xlAnd
    Rows("2:10000").Select
    Range("H2").Activate
    Selection.SpecialCells(xlCellTypeVisible).Select
    Selection.Delete Shift:=xlUp
    Rows("1:1").Select
    Range("H1").Activate
    Selection.AutoFilter
    Columns("S:S").Select
    Selection.Copy
    ActiveWindow.SmallScroll ToRight:=4
    Columns("U:U").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("U:U").EntireColumn.AutoFit
    Columns("U:U").Select
    Application.CutCopyMode = False
    Selection.TextToColumns Destination:=Range("U1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="/", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
     Columns("O:O").Select
    Selection.Copy
    Columns("W:W").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("K:K").Select
    Application.CutCopyMode = False
    Selection.Copy
    Columns("X:X").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("M:M").Select
    Application.CutCopyMode = False
    Selection.Copy
    Columns("Y:Y").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("B:B").Select
    Application.CutCopyMode = False
    Selection.Copy
    Columns("AA:AA").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("J:J").Select
    Application.CutCopyMode = False
    Selection.Copy
    Columns("AB:AB").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.Replace What:="[WH]", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Selection.Replace What:="(*)", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Range("Z2").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=RIGHT(RC[-24],2)&"" ""&RC[2]"
    Range("Z2").Select
    Selection.AutoFill Destination:=Range("Z2:Z1000"), Type:=xlFillDefault
    Range("Z2:Z1000").Select
    Columns("Z:Z").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("U2:AA1000").Select
    Selection.Copy
    Sheets("上传").Select
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("包装明细").Select
    Columns("U:AY").Select
    Selection.Delete Shift:=xlToLeft
    Range("A2").Select
    Sheets("上传").Select
    Range("A2").Select
    ActiveWorkbook.Save
    Application.ScreenUpdating = True
Dim Arr, i&, wb As Workbook, nm1$
Dim d, k, t, j&, aa
Application.ScreenUpdating = False
Set d = CreateObject("Scripting.Dictionary")
Set wb = ThisWorkbook
Sheet1.Activate
Arr = [a1].CurrentRegion
For i = 2 To UBound(Arr)
    d(Arr(i, 7)) = d(Arr(i, 7)) & i & ","
Next
k = d.keys: t = d.items
For i = 0 To UBound(k)
    nm1 = k(i)
    Workbooks.Add
    With ActiveWorkbook
        With .Sheets(1)
            .Cells.NumberFormatLocal = "@"
            .Select
            .[a1].Resize(1, UBound(Arr, 2)) = Application.Index(Arr, 1, 0)
            t(i) = Left(t(i), Len(t(i)) - 1)
            If InStr(t(i), ",") Then
                aa = Split(t(i), ",")
                For j = 0 To UBound(aa)
                    .Cells(j + 2, 1).Resize(1, UBound(Arr, 2)) = Application.Index(Arr, aa(j), 0)
                Next
            Else
                .Cells(j + 2, 1).Resize(1, UBound(Arr, 2)) = Application.Index(Arr, t(i), 0)
            End If
            .Cells.EntireColumn.AutoFit
        End With
        .SaveAs ThisWorkbook.Path & "\" & nm1 & ".xlsx"
        .Close
         j = 0
    End With
Next
End Sub