将工作簿中符合条件的工作表导出另存为一个工作簿，并且不带公式

delikcpa

求助：
将工作簿第一个字符为“R”的工作表导出另外保存为一个新的文档，文件名为：高新专审-研发投入@0001华龙精密模具，其中“0001”在工作表名为“信息”的M3单元格提取，“华龙精密模具”在单元格C14中提取。另外，各表中的公式删除，只保留数值。求高手帮忙解决！

liulang0808

需求没有看太明白，如果仅仅是个别表格导出，手工操作即可
或者按照楼主的描述，录制一段宏，然后对应修改看看

如果还有疑问建议模拟部分结果，并上传附件对应描述下具体实现过程

3190496160

vba设置了工程密码

ykcbf1100

你VBA设了密码

3190496160

Sub 另存为()
With Sheets("信息")
    mc = "高新专审-研发投入@" & .[m3] & .[c13]
End With
For Each Sh In Sheets
    If InStr(Sh.Name, "R") > 0 Then
        m = m + 1
        If m = 1 Then
            Sh.Copy
            Set wb = ActiveWorkbook
        Else
            Sh.Copy after:=wb.Worksheets(wb.Worksheets.Count)
        End If
    End If
Next Sh
For Each sht In wb.Worksheets
    sht.UsedRange = sht.UsedRange.Value
Next sht
wb.SaveAs Filename:=ThisWorkbook.Path & "\" & mc & ".xls"
wb.Close
End Sub

3190496160

2_高新专审@模板.rar (93.26 KB, 下载次数: 10)

2022-5-20 08:59 上传

点击文件名下载附件

一条小笨笨

可以先把表复制过去再选择性粘贴成数值和格式吧

ykcbf1100

测试通过。VBA密码清除了，你自己设回去吧。

你试一下吧。

ykcbf1100

代码重写。。。

ykcbf1100

1. Sub ykcbf()    '//2025.3.14
   
2.     Application.ScreenUpdating = False
   
3.     Application.DisplayAlerts = False
   
4.     Set ws = ThisWorkbook
   
5.     Set Sh = ws.Sheets("信息")
   
6.     p = ws.Path & ""
   
7.     fn = "高新专审-研发投入@" & Sh.[m3].Value & Sh.[c14].Value
   
8.     On Error Resume Next
   
9.     For Each sht In Worksheets
   
10.         If Left(sht.Name, 1) = "R" Then
    
11.             m = m + 1
    
12.             If m = 1 Then sht.Select Else sht.Select False
    
13.         End If
    
14.     Next
    
15.     ActiveWindow.SelectedSheets.Copy
    
16.     Set wb = ActiveWorkbook
    
17.     For Each sht In wb.Sheets
    
18.         With sht
    
19.             .UsedRange.Value = .UsedRange.Value
    
20.             .DrawingObjects.Delete
    
21.         End With
    
22.     Next
    
23.     wb.SaveAs p & fn
    
24.     wb.Close
    
25.     Application.ScreenUpdating = True
    
26.     MsgBox "OK！"
    
27. End Sub
    

复制代码