含宏工作薄另存为一个新的（不含宏）工作簿，[所有工作表只复制数值、格式，不复制公

first-hdy

jpj123 发表于 2015-4-8 18:23
给你段为选中区域加边框的代码参考：再不行的的话，建议上传附件。

就是8楼您的那个附件，请帮看一下，谢谢！

first-hdy

jpj123 发表于 2015-4-8 17:35

试了这代码个保存后，原件的公式也被删掉了，能不能只删新工作簿上的公式和代码，而原件上的保留不动！

Sub 按钮1_Click()
Dim sht As Worksheet
Application.EnableEvents = False
Application.DisplayAlerts = False
For Each sht In Sheets
sht.UsedRange = sht.UsedRange.Value
Next
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\文件-另存.xlsx", FileFormat:= _
        xlOpenXMLWorkbook, CreateBackup:=False
ActiveWorkbook.Close True
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub

jpj123

first-hdy 发表于 2015-4-8 18:44
试了这代码个保存后，原件的公式也被删掉了，能不能只删新工作簿上的公式和代码，而原件上的保留不动！
...

我再看看，稍等!

jpj123

1. Sub 按钮1_Click()
   
2. Dim sht As Worksheet
   
3. Application.EnableEvents = False
   
4. Application.DisplayAlerts = False
   
5. ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\文件-另存.xlsx", FileFormat:= _
   
6.         xlOpenXMLWorkbook, CreateBackup:=False
   
7. For Each sht In Sheets
   
8. sht.UsedRange = sht.UsedRange.Value
   
9. Next
   
10. ActiveWorkbook.Close True
    
11. Application.DisplayAlerts = True
    
12. Application.EnableEvents = True
    
13. End Sub
    

复制代码

调整了一下删除公式代码的位置

jpj123

详见附件   

jpj123

汇总表的边框：

1. Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
   
2. If Sh.Name = "填单" And Target.Address = "$B$1" And Target.Value <> "" Then
   
3. Dim brr(1 To 1, 1 To 3)
   
4. Application.EnableEvents = False
   
5. Worksheets("填单").Copy after:=Worksheets("填单")
   
6.     With ActiveSheet
   
7.         .Name = [b1].Value
   
8.         brr(1, 1) = .[b1]: brr(1, 2) = .[j1]: brr(1, 3) = .[j2]
   
9.     End With
   
10.     With Worksheets("汇总")
    
11.         .Activate
    
12.         X = .Cells(Rows.Count, "c").End(3).Row
    
13.         .Rows(X).Clear
    
14.         With .Cells(X, "c")
    
15.              .Resize(, 3) = brr
    
16.              .Offset(1) = "汇总"
    
17.              .Offset(1, 1) = Application.Sum(Range("d3:d" & X))
    
18.              .Offset(1, 2) = Application.Sum(Range("e3:e" & X))
    
19.         End With
    
20.     End With
    
21. End If
    
22. X = Worksheets("汇总").Cells(Rows.Count, "c").End(3).Row
    
23. With Worksheets("汇总").Range("A3:F" & X).Borders
    
24.     .LineStyle = xlNone
    
25.     .ColorIndex = 0
    
26.     .TintAndShade = 0
    
27.     .Weight = xlThin
    
28. End With
    
29. Application.EnableEvents = True
    
30. End Sub
    

复制代码

jpj123

请测试 附件   

first-hdy

jpj123 发表于 2015-4-8 19:31
请测试 附件

非常感谢！

jonsonchang

jpj123 发表于 2015-4-8 19:22
调整了一下删除公式代码的位置

大神，在这基础上，能不能把老文件所有sheet内容只粘贴数值到新的文件中？把底色，筛选等一切格式都不要，只要复制后粘贴数值的效果，行吗？

蒋智龙

插眼 留个记号 好东西