Sub CreateSaleList()    AppSettings    On Error GoTo ErrHandler    Dim StartTime As Variant    '开始时间    Dim UsedTime As Variant    '使用时间    StartTime = VBA.Timer    '记录开始时间    Dim Wb As Workbook    Dim Sht As Worksheet    Dim oSht As Worksheet    Dim NewSht As Worksheet    Dim iRow As Long    Dim NewRow As Long    Dim Dic As Object    Dim Key As String    Dim PageNo As Long    Set Wb = Application.ThisWorkbook    For Each oSht In Wb.Worksheets        If oSht.Name <> "明细" And oSht.Name <> "模板" Then            Debug.Print oSht.Name            oSht.Delete        End If    Next oSht    Set Sht = Wb.Worksheets("明细")    Set oSht = Wb.Worksheets("模板")    Set Dic = CreateObject("Scripting.Dictionary")    With Sht        iRow = 3        Do While .Cells(iRow, 1).Value <> ""            Key = .Cells(iRow, 1).Value            Dic(Key) = Dic(Key) + 1            PageNo = Int((Dic(Key) - 1) / 5) + 1            NewName = Key & "(" & PageNo & ")"            If Dic(Key) Mod 5 = 1 Then                '  On Error Resume Next                '  Wb.Worksheets(NewName).Delete                '  On Error GoTo 0                oSht.Copy After:=Wb.Worksheets(Wb.Worksheets.Count)                Set NewSht = Wb.Worksheets(Wb.Worksheets.Count)                NewSht.Name = Key & "(" & PageNo & ")"                NewSht.Range("B3").Value = .Cells(iRow, "C").Value                NewSht.Range("E3").Value = .Cells(iRow, "B").Value                NewSht.Range("G2").Value = NewSht.Range("G2").Value & .Cells(iRow, "A").Value                NewSht.Range("G3").Value = NewSht.Range("G3").Value & .Cells(iRow, "L").Value            End If            NewRow = 4 + (Dic(Key) - 1) Mod 5 + 1            NewSht.Cells(NewRow, 1).Value = .Cells(iRow, 6).Value            NewSht.Cells(NewRow, 2).Value = .Cells(iRow, 7).Value            NewSht.Cells(NewRow, 3).Value = .Cells(iRow, 8).Value            NewSht.Cells(NewRow, 4).Value = .Cells(iRow, 11).Value            NewSht.Cells(NewRow, 5).Value = .Cells(iRow, 10).Value            NewSht.Cells(NewRow, 6).Value = .Cells(iRow, 13).Value            NewSht.Cells(NewRow, 7).Value = .Cells(iRow, 9).Value            iRow = iRow + 1            If iRow = 60 Then Exit Do  '防止死循环        Loop    End With    Set Wb = Nothing    Set Sht = Nothing    Set oSht = Nothing    Set NewSht = Nothing    AppSettings False    UsedTime = VBA.Timer - StartTime    MsgBox "本次运行耗时：" & Format(UsedTime, "#0.0000秒")ErrorExit:    AppSettings False    Exit SubErrHandler:    If Err.Number <> 0 Then        MsgBox Err.Description & "！", vbCritical, "QQ 84857038"        Debug.Print Err.Description        Err.Clear        Resume ErrorExit    End IfEnd SubPublic Sub AppSettings(Optional IsStart As Boolean = True)    If IsStart Then        Application.ScreenUpdating = False        Application.DisplayAlerts = False        Application.Calculation = xlCalculationManual        Application.StatusBar = ">>>>>>>>Macro Is Running>>>>>>>>"    Else        Application.ScreenUpdating = True        Application.DisplayAlerts = True        Application.Calculation = xlCalculationAutomatic        Application.StatusBar = False    End IfEnd Sub