vba保存文件为xlsx格式_另存为xlsx格式疑问

我想要excel另存为xlsx格式的文件，这个文件所有的东西选择性粘贴、去掉个人信息、取消隐藏、以显示精度为准，而不改变原来的excel文件，下面代码当excel sheet少的时候没问题，但当表格多的时候就卡死，一直转圈 求大神帮忙

Sub Maco()

Dim C  As Shape

Dim Wb As Workbook

Dim I  As Long

Dim Sh As Worksheet

Dim kl As Integer

Dim na As Name

Dim wkbOne As Workbook

Application.ScreenUpdating = False

ActiveWorkbook.PrecisionAsDisplayed = True

Application.DisplayAlerts = False

ActiveWorkbook.Sheets.Copy

Set Wb = ActiveWorkbook

For I = 1 To Wb.Sheets.count

For Each C In Sheets(I).Shapes

If C.Type = 8 Or C.Type = 12 Then C.Delete

Next

For Each Sh In Sheets

Sh.Protect AllowFiltering:=True

Sh.Unprotect '去密码保护

Sh.UsedRange = Sh.UsedRange.Value '选择性粘贴

Next

For kl = 1 To Sheets.count '取消隐藏表

Sheets(kl).Visible = True

Next kl

On Error Resume Next

For Each na In ActiveWorkbook.Names '删除名称管理器

Debug.Print na.Name

na.Visible = True

na.Delete

Next

Set wkbOne = Application.ActiveWorkbook '删除个人信息

wkbOne.RemovePersonalInformation = True

Next

Application.Dialogs(xlDialogSaveAs).Show ("XXX工程电子版.xlsx")

Wb.Close

'Application DisplayAlerts = True

'ActiveWorkbook.PrecisionAsDisplayed = False

Application.ScreenUpdating = True

End Sub