vba求助能修改为另存为无公式的代码吗？

陳称陈

Sub 导出工作表选定区域()
On Error Resume Next
Dim sRng As Range, sh, i, nm              '定义区域为选择区域
'Set sRng = Selection
Dim tBook As Workbook
Dim fName$                        '定义工作薄完整名

sh = InputBox("请输入要导出的工作表的名字")   '输入要导出工作表的名称
Sheets(sh).Visible = True
Sheets(sh).Select
Set sRng = Application.InputBox("请选择数据输出范围", Type:=8)  '这个语句是选择区域。
Set tBook = Workbooks.Add  '新建工作薄
fName = ThisWorkbook.Path & "\" & sh & Format(Date, "yyyy-MM-dd") & "_" & ".xlsx"        '& Format(Time, "hhmmss")日期_时间.xlsx
With tBook
sRng.Copy .Sheets(1).[A1]      '复制选中区域
.Close True, fName             '关闭并保存新工作薄
End With
Shell "explorer.exe /select," & fName, vbNormalFocus    '在浏览器中选中导出工作薄
Set tBook = Nothing
End Sub

gwjkkkkk

请参考。。。

niko88819

请测试看一看

1. Sub 导出工作表选定区域()
   
2.     On Error Resume Next
   
3.     Dim sRng As Range, sh, i, nm              '定义区域为选择区域
   
4.     'Set sRng = Selection
   
5.     Dim tBook As Workbook
   
6.     Dim fName$                        '定义工作薄完整名
   
7. 
   
8.     sh = InputBox("请输入要导出的工作表的名字")   '输入要导出工作表的名称
   
9.     Sheets(sh).Visible = True
   
10.     Sheets(sh).Select
    
11.     Set sRng = Application.InputBox("请选择数据输出范围", Type:=8)  '这个语句是选择区域。
    
12.     Set tBook = Workbooks.Add  '新建工作薄
    
13.     fName = ThisWorkbook.Path & "" & sh & Format(Date, "yyyy-MM-dd") & "_" & ".xlsx"        '& Format(Time, "hhmmss")日期_时间.xlsx
    
14.    
    
15.     '将选择的区域值复制到新工作簿
    
16.     sRng.Copy
    
17.     tBook.Sheets(1).Range("A1").PasteSpecial xlPasteValues
    
18.     Application.CutCopyMode = False '清除剪切板内容
    
19.    
    
20.     With tBook
    
21.         .SaveAs fName, xlOpenXMLWorkbook '将新工作簿另存为指定路径和文件名
    
22.         .Close False '关闭新工作簿
    
23.     End With
    
24.    
    
25.     Shell "explorer.exe /select," & fName, vbNormalFocus    '在浏览器中选中导出工作薄
    
26.     Set tBook = Nothing
    
27. End Sub

复制代码

taller

陳称陈

taller 发表于 2023-6-11 02:04

谢谢完美解决，好厉害

陳称陈

niko88819 发表于 2023-6-10 19:40
请测试看一看

谢谢，但是我想要保留格式

niko88819

陳称陈 发表于 2023-6-12 10:44
谢谢，但是我想要保留格式

想要保留原格式,请再试一试

1. Sub 导出工作表选定区域()
   
2.     On Error Resume Next
   
3.     Dim sRng As Range, sh, i, nm              '定义区域为选择区域
   
4.     'Set sRng = Selection
   
5.     Dim tBook As Workbook
   
6.     Dim fName$                        '定义工作薄完整名
   
7. 
   
8.     sh = InputBox("请输入要导出的工作表的名字")   '输入要导出工作表的名称
   
9.     Sheets(sh).Visible = True
   
10.     Sheets(sh).Select
    
11.     Set sRng = Application.InputBox("请选择数据输出范围", Type:=8)  '这个语句是选择区域。
    
12.     Set tBook = Workbooks.Add  '新建工作薄
    
13.     fName = ThisWorkbook.Path & "" & sh & Format(Date, "yyyy-MM-dd") & "_" & ".xlsx"        '& Format(Time, "hhmmss")日期_时间.xlsx
    
14.    
    
15.     '将选择的区域复制到新工作簿
    
16.     sRng.Copy
    
17.     tBook.Sheets(1).Range("A1").PasteSpecial Paste:=xlPasteAllUsingSourceTheme, Operation:=xlNone
    
18. 
    
19.     Application.CutCopyMode = False '清除剪切板内容
    
20.    
    
21.     With tBook
    
22.         .SaveAs fName, xlOpenXMLWorkbook '将新工作簿另存为指定路径和文件名
    
23.         .Close False '关闭新工作簿
    
24.     End With
    
25.    
    
26.     Shell "explorer.exe /select," & fName, vbNormalFocus    '在浏览器中选中导出工作薄
    
27.     Set tBook = Nothing
    
28. End Sub
    

复制代码

陳称陈

gwjkkkkk 发表于 2023-6-10 18:00
请参考。。。

谢谢，还是有公式呢

陳称陈

niko88819 发表于 2023-6-12 10:50
想要保留原格式,请再试一试

嗯嗯，可以了厉害的