|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
- Sub Macro1()
- Dim sh As Worksheet, p$
- Application.ScreenUpdating = False
- Application.DisplayAlerts = False
- p = ThisWorkbook.Path & ""
- For Each sh In Worksheets
- If sh.Visible = xlSheetVisible And sh.Name <> "首页" Then
- sh.Copy
- ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
- , AllowFiltering:=True, AllowUsingPivotTables:=True
- ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
- False, AllowFiltering:=True, AllowUsingPivotTables:=True
- ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:= _
- False, AllowFiltering:=True, AllowUsingPivotTables:=True
- ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
- True, AllowFiltering:=True, AllowUsingPivotTables:=True
- ActiveSheet.Unprotect
- With ActiveSheet.UsedRange
- .Value = .Value
- End With
- For Each shp In ActiveSheet.Shapes
- shp.Delete
- Next
- ActiveWorkbook.Close True, p & sh.Name & ".xls"
- End If
- Next
- Application.ScreenUpdating = True
- MsgBox "保存完毕"
- End Sub
复制代码 |
|