Tabellen kopieren und übertragen

Hallo Leute,
ich habe eine Excel Datei mit UserForm und Makros, die ist verschlüsselt und der Code hat auch ein Passwort.
Der User soll auf den Button speichern drücken um die Datei mit anderem Namen auf dem Desktop zu speichern.
Ich habe es mit SaveAs probiert und habe die Datei als OpenXMLWorkbook gespeichert damit Makros und Userform nicht gespeichert werde, dadurch ist aber immer noch ein Passwort usw drauf.
Also habe ich mir gedacht mach ich es anders und erstelle beim Button drücken einfach ein neues Workbook, dann Kopiere ich alle Tabellenblätter der Hauptdatei und Füge sie in das neue Workbook ein.
Mein Code Ansatz bis jetzt:

vDatum = Date
UserN = (Environ("UserName"))
strSavePfad = "C:\Users\" & UserN & "\Desktop\"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
strSaveName = InputBox("Bitte geben Sie der Datei vor dem Speichern einen Namen: ")
If strSaveName = "" Then Exit Sub
Set nWkb = Workbooks.Add
For Each ws In ThisWorkbook.Sheets
ws.Select
Selection.Copy
'Application.CutCopyMode = False
With nWkb
Selection.PasteSpecial Paste:=xlPasteAll
End With
Next ws
Workbooks(nWkb).Close SaveChanges:=True, Filename:=strSavePfad & strSaveName & "_" & vDatum

For Each ws In nWkb.Sheets
If Left(ws.Name, 7) = "Tabelle" Then
ws.Delete
End If
Next ws