Dim wn$, shp As Shape, arr

  Application.ScreenUpdating = False

  Application.DisplayAlerts = False

  wn = [a1]

  arr = Range("o3:o" & Range("o65536").End(xlUp).Row)

  Sheets("报表").Copy

  With ActiveWorkbook

  With .Sheets(1)

  .Rows("1:2").Delete Shift:=xlUp

  .Range("D:D,P:P").NumberFormatLocal = "@"

  .[o1].Resize(UBound(arr)) = arr

  With .UsedRange

  .Value = .Value

  End With

  For Each shp In .Shapes

  shp.Delete

  Next

  End With

  .SaveAs ThisWorkbook.Path & "" & wn & ".xls", IIf(Application.Version <= 11, xlNormal, xlExcel8)

  .Close

  End With

  Application.DisplayAlerts = True

  Application.ScreenUpdating = True

  MsgBox "ok"