|
仅供参考
Sub test2020()
Dim r%, mp$, mf$
Application.DisplayAlerts = False: Application.ScreenUpdating = False '禁止弹警告
mp = ThisWorkbook.Path & "\" '路径
myname = "项目更新" & Format(Date, "yyyymmdd") '预设一个工作薄名称
mf = Dir(mp & "*" & myname & "*.xls*") '显示工作薄名称
If mf <> "" Then Kill mp & mf '如果已经有了,就删除它
ThisWorkbook.Sheets("项目更新").Copy: ActiveWorkbook.SaveAs mp & myname & ".xls" '保存为新工作薄
r = ActiveWorkbook.Sheets("项目更新").Columns("a:a").Find("检查列").Row '查找有“检查列”几个字所有行
ActiveWorkbook.Sheets("项目更新").Rows(r).Clear '清除
arr = ActiveWorkbook.Sheets("项目更新").UsedRange '赋值给数组
ActiveWorkbook.Sheets("项目更新").[a1:z60000].ClearContents '清空数据,保留格式
ActiveWorkbook.Sheets("项目更新").[a1].Resize(UBound(arr), UBound(arr, 2)) = arr '将数组输出到单元格区域(无公式了)
ActiveWorkbook.Close True '关闭时保存
MsgBox "OK,完成!!!", 48, "温馨提示……"
Application.DisplayAlerts = True: Application.ScreenUpdating = True
End Sub |
|