求另存整个工作簿模块修改

icenotcool

各位老师好：我想把下面这个模块修改一下，要求：求另存整个工作簿（去掉宏，去掉链接，去掉所有按钮，去掉函数公式，保留报表格式，去掉工作簿vba工程密码）。然后设置任意保存文件夹，任意设置新工作簿名称。
下面这个是zjdh老师：给我写的单表另存为的模块：我想改为另存整个工作簿，先谢谢各位老师了，
Sub 另存工作表保留格式成本()
  Dim arr, myname$, whname$, st$, shap As Shape
    arr = ThisWorkbook.Sheets(15).UsedRange
    myname = Application.GetOpenFilename("excel文件,*.xls*")
    If myname <> "False" Then
        With Workbooks.Open(myname)
            st = Application.InputBox("请输入要保存的工作表名", "输入")
            .Sheets.Add after:=Sheets(Sheets.Count)
            ActiveSheet.Name = st
            ThisWorkbook.Sheets(15).UsedRange.Copy
            .Sheets(st).[a1].PasteSpecial Paste:=xlPasteFormats
            .Sheets(st).[a1].PasteSpecial Paste:=xlPasteColumnWidths
            .Sheets(st).[a1].Resize(UBound(arr), UBound(arr, 2)) = arr
            .Close True
        End With
   End If
End Sub