工作表保留格式去除公式另存工作薄

26791tt

求助，附件表格有几个需求：1.“项目更新”表格去除公式，但需要保留格式；
2.验证列文字变成白色或另存时删除；
3.另存到指定的文件夹，新工作簿命名的时候要“项目更新YYMMDD”文件名要有日期后缀。
感觉需求比较多，搞了好久没法都满足，求助大大。

网海遨游

仅供参考

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

网海遨游

代码在审核，附件仅供参考

26791tt

网海遨游 发表于 2019-12-14 11:21
代码在审核，附件仅供参考

太感谢您了 谢谢

26791tt

网海遨游 发表于 2019-12-14 11:19
仅供参考

Sub test2020()

代码很好用，感谢感谢。但是为什么打开生成的表格时候，会出现：文件格式和扩展名不匹配，文件可能已损坏或不安全。除非信任，否则请勿打开

网海遨游

26791tt 发表于 2019-12-14 20:54
代码很好用，感谢感谢。但是为什么打开生成的表格时候，会出现：文件格式和扩展名不匹配，文件可能已损坏 ...

可能是保存为.xls后缀名问题，可将代码中文件名后缀.xls改成.xlsx后缀

26791tt

网海遨游 发表于 2019-12-15 08:02
可能是保存为.xls后缀名问题，可将代码中文件名后缀.xls改成.xlsx后缀

好的 我再试试 非常感谢您

26791tt

网海遨游 发表于 2019-12-15 08:02
可能是保存为.xls后缀名问题，可将代码中文件名后缀.xls改成.xlsx后缀

您好，代码:mp = ThisWorkbook.Path & "\" '路径
是保存到同一个文件夹了，如果有另存的指定文件夹呢？比如“F:\文件夹A\1号”这种？

网海遨游

mp=“F:\文件夹A\1号\”
'前提是F盘必须有这样层级与名称的文件夹。

26791tt

网海遨游 发表于 2019-12-16 16:22
mp=“F:\文件夹A\1号\”
'前提是F盘必须有这样层级与名称的文件夹。

收到  谢谢您的指导