Hi,
I am using the following code to copy and save a worksheet from a workbook as a separate workbook. The worksheet that is being saved as a separate workbook contains some VBA, which also gets saved in the process. The problem I have is protecting the VBA code within the copied worksheet as it is transfered to a new workbook. The code is protected within the original workbook.

Sub Save()
'Working in 97-2010
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim Sourcewb As Workbook
    Dim Destwb As Workbook
    Dim FilePath As String
    Dim FileName As String
    Dim I As Long
    Dim DrL As String

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    
    DrL = Left(ActiveWorkbook.FullName, 2)

    If ThisWorkbook.Worksheets("PK-PD").Range("V26") <> "" Then
    MsgBox "BC File already exists for these samples."
    GoTo FIN
    Else
    End If
    
    Set Sourcewb = ActiveWorkbook

    'Copy the sheet to a new workbook
    ThisWorkbook.Worksheets("BC SHEET").Visible = True
    ThisWorkbook.Worksheets("BC SHEET").Copy
    ThisWorkbook.Worksheets("BC SHEET").Visible = False
    Set Destwb = ActiveWorkbook
    
    'Determine the Excel version and file extension/format
    With Destwb
        If Val(Application.Version) < 12 Then
            'You use Excel 97-2003
            FileExtStr = ".xls": FileFormatNum = -4143
        Else
            'You use Excel 2007-2010, we exit the sub when your answer is
            'NO in the security dialog that you only see  when you copy
            'an sheet from a xlsm file with macro's disabled.
            If Sourcewb.Name = .Name Then
                With Application
                    .ScreenUpdating = True
                    .EnableEvents = True
                End With
                MsgBox "Your answer is NO in the security dialog"
                Exit Sub
            Else
                Select Case Sourcewb.FileFormat
                Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
                Case 52:
                    If .HasVBProject Then
                        FileExtStr = ".xlsm": FileFormatNum = 52
                    Else
                        FileExtStr = ".xlsx": FileFormatNum = 51
                    End If
                Case 56: FileExtStr = ".xls": FileFormatNum = 56
                Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
                End Select
            End If
        End If
    End With

    '    'Change all cells in the worksheet to values if you want
        With Destwb.Sheets(1).UsedRange
        ActiveSheet.Unprotect Password:="AJA"
            .Cells.Copy
            .Cells.PasteSpecial xlPasteValues
            .Cells(1).Select
            ActiveSheet.Protect Password:="AJA"
        End With
        Application.CutCopyMode = False
        
        
 Dim shp As Shape
 Dim myVar As Shapes
 
ActiveSheet.Activate
 Count = ActiveSheet.Shapes.Count
 
'Set myVar = Sheets(ActiveSheet.Name).Shapes
 For I = Count To 1 Step -1
 ActiveSheet.Shapes(I).Delete 'myVar(i).Delete
 Next I

    'Save the new workbook
    FilePath = DrL & "\BSS\BC Files - For use with BC Scanner\"
    FileName = ThisWorkbook.Worksheets("PK-PD").Range("R2").Value & Right(ThisWorkbook.Worksheets("PK-PD").Range("A2").Value, 5)

    With Destwb
        .SaveAs FilePath & FileName & FileExtStr, _
                FileFormat:=FileFormatNum
        On Error Resume Next
      
        On Error GoTo 0
        .Close SaveChanges:=True
    End With
    
    ActiveSheet.Unprotect Password:="AJA"
    ThisWorkbook.Worksheets("PK-PD").Range("V26") = Date
    Range("V26").Select
    Selection.Locked = True
    ActiveSheet.Protect Password:="AJA"

MsgBox "Barcode File created. Please make sure this file is 100% correct and SAVE"
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
FIN:
End Sub
Is it possible to set the password to protect the code in the new workbook while creating the workbook within the above code? Help!!