Vba Excel error using SaveAs with password

Question

I wrote a simply code to save every Excel Worksheet as a new file (.xlsx) protected with password:

 For i = 1 To 7

   ThisWorkbook.Sheets(i).Copy   
   ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & i & ".xlsx", FileFormat:=51, Password:="XXX"
   ActiveWorkbook.Close False

Next i 

It works but the error is that the created files seem to have a sort of autorun (they auto-open if you simply click on the icons) and then the Excel popup about password shows "copy of && is protected" in adding to "&& is protected" and ask for the password twice.

Any ideas?

Thanks

Answer 1

A general peace of advice, do not use ThisWorkbook, ActiveWorkbook, Active Worksheet etc. if not 100% neccessary. It more often than not causes problems. Second thing, sometimes a few more lines of code are better than less, because of debugability.

The most important points of code below: Your workbook of source is defined as wbSource and you initialize a variable wbTarget . For each worksheet in the workbook you create a new workbook by Set wbTarget = Workbooks.Add copy the sheet mySheet the iterator to it, set the password and save it. This can be done in one row, but again this is very clear and debugable.

Sub test()

    Application.DisplayAlerts = False
    Application.ScreenUpdating = False

    Dim wbSource As Workbook, wbTarget As Workbook
    Dim wsToCopy As Worksheet

    Set wbSource = ThisWorkbook

    For Each mySheet In wbSource.Sheets
        Set wbTarget = Workbooks.Add
        mySheet.Copy Before:=wbTarget.Sheets(1)
        wbTarget.Password = "XXX"
        wbTarget.Close True, mySheet.Name
    Next mySheet

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

End Sub