Creating new workbook from the template that exist in the current workbook

Question

Here is what I have, need to be able to save any template called in ComboBox as separate workbook without any macro in the new one, but with preserving formulas with internal references, rest should be converted to values.

Hear is my attempt to do so, which clearly did not work, since it is saving an active sheet, instead of the template Which is selected. also because of validation, that is necessary, I am forced to use part of the code twice, is there any way of doing it in any different way.

I think I also need to mention that ComboBox is on UserForm.

Please help me

'Continue to create your invoice and check for the archive folder existance
Private Sub ContinueButton_Click()
    If cmbSheet.Value = "" Then
    MsgBox "Please select the Invoice Template from the list to continue."
    ElseIf cmbSheet.Value <> 0 Then
    Dim response
    Application.ScreenUpdating = 0
    Sheets(cmbSheet.Value).Visible = True
'Creating the directory only if it doesn't exist
    directoryPath = getDirectoryPath
    If Dir(directoryPath, vbDirectory) = "" Then
        response = MsgBox("The directory " & Settings.Range("_archiveDir").Value & " does not exist. Would you like to create it?", vbYesNo)
        If response = vbYes Then
            createDirectory directoryPath
            MsgBox "The folder has been created. " & directoryPath




            'Application.Goto Sheets(cmbSheet.Value).[a22], True
            Application.ScreenUpdating = False
        Else
            MsgBox "You need to create new folder " & Settings.Range("_archiveDir").Value & " to archive your invoices prior to creating them."
            Unload Me
        End If
        Unload Me
    ElseIf Dir(directoryPath, vbDirectory) <> directoryPath Then

        'Working in Excel 97-2007
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim Sourcewb As Workbook
    Dim Destwb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim newFile As String, fName As String
    Dim sep As String
    sep = Application.PathSeparator

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    Set Sourcewb = ActiveWorkbook

    'Copy the sheet to a new workbook
    ActiveSheet.Copy
    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
            'We exit the sub when your answer is NO in the security dialog that you
            'only see when you copy a 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 = 56
                Case 52:
                    If .HasVBProject Then
                        FileExtStr = ".xlsm": FileFormatNum = 56
                    Else
                        FileExtStr = ".xlsx": FileFormatNum = 56
                    End If
                Case 56: FileExtStr = ".xls": FileFormatNum = 56
                Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
                End Select
            End If
        End If
    End With

    '    'If you want to change all cells in the worksheet to values, uncomment these lines.
    '    With Destwb.Sheets(1).UsedRange
    '        .Cells.Copy
    '        .Cells.PasteSpecial xlPasteValues
    '        .Cells(1).Select
    '    End With
    '    Application.CutCopyMode = False

    'Save the new workbook and close it
    fName = Range("I11").Value
     'Change the date format to whatever you'd like, but make sure it's in quotes
    newFile = fName & " " & Format$(Date, "mm-dd-yyyy") & Columns("M:N").Select
    Selection.Delete Shift:=xlToLeft
    TempFilePath = directoryPath & sep
    TempFileName = "New File"

    With Destwb
        .SaveAs TempFilePath & TempFileName, FileFormat:=FileFormatNum
        .Close SaveChanges:=False
    End With

    MsgBox "You can find the new file in " & TempFilePath

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With


        'Application.Goto Sheets(cmbSheet.Value).[a22], True
        Application.ScreenUpdating = False
        Unload Me
    End If
    End If
End Sub

Answer 1

As it is the template sheet that you want to copy, you probably want to do Sourcewb.Sheets(cmbSheet.Value).Copy instead of ActiveSheet.Copy.

To avoid running the code twice, change this code:

    Else
        MsgBox "You need to create new folder " & Settings.Range("_archiveDir").Value & " to archive your invoices prior to creating them."
        Unload Me
    End If
    Unload Me
ElseIf Dir(directoryPath, vbDirectory) <> directoryPath Then

to this instead:

    Else
        MsgBox "You need to create new folder " & Settings.Range("_archiveDir").Value & " to archive your invoices prior to creating them."
        Unload Me
    End If
End If
If Dir(directoryPath, vbDirectory) <> directoryPath Then

Here is the whole code after my changes

Option Explicit

'Continue to create your invoice and check for the archive folder existance
Private Sub ContinueButton_Click()

    If cmbsheet.Value = "" Then
        MsgBox "Please select the Invoice Template from the list to continue."
    ElseIf cmbsheet.Value <> 0 Then
        Dim response
        Application.ScreenUpdating = 0
        'Creating the directory only if it doesn't exist
        directoryPath = getDirectoryPath
        If Dir(directoryPath, vbDirectory) = "" Then
            response = MsgBox("The directory " & Settings.Range("_archiveDir").Value & " does not exist. Would you like to create it?", vbYesNo)
            If response = vbYes Then
                createDirectory directoryPath
                MsgBox "The folder has been created. " & directoryPath

                'Application.Goto Sheets(cmbSheet.Value).[a22], True
                Application.ScreenUpdating = False
            Else
                MsgBox "You need to create new folder " & Settings.Range("_archiveDir").Value & " to archive your invoices prior to creating them."
                'Unload Me
                GoTo THE_END
            End If
        End If
        If Dir(directoryPath, vbDirectory) <> directoryPath Then
            Sheets(cmbsheet.Value).Visible = True

                'Working in Excel 97-2007
            Dim FileExtStr As String
            Dim FileFormatNum As Long
            Dim Sourcewb As Workbook
            Dim Destwb As Workbook
            Dim TempFilePath As String
            Dim TempFileName As String
            Dim newFile As String, fName As String
            Dim sep As String
            sep = Application.PathSeparator

            With Application
                .ScreenUpdating = False
                .EnableEvents = False
            End With

            Set Sourcewb = ActiveWorkbook

            'Copy the sheet to a new workbook
            Sourcewb.Sheets(cmbsheet.Value).Copy
            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
                    'We exit the sub when your answer is NO in the security dialog that you
                    'only see when you copy a 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
                        GoTo THE_END
                    Else
                        Select Case Sourcewb.FileFormat
                        Case 51: FileExtStr = ".xlsx": FileFormatNum = 56
                        Case 52:
                            If .HasVBProject Then
                                FileExtStr = ".xlsm": FileFormatNum = 56
                            Else
                                FileExtStr = ".xlsx": FileFormatNum = 56
                            End If
                        Case 56: FileExtStr = ".xls": FileFormatNum = 56
                        Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
                        End Select
                    End If
                End If
            End With

            'If you want to change all cells in the worksheet to values, uncomment these lines.
            'With Destwb.Sheets(1).UsedRange
            With Sourcewb.Sheets(cmbsheet.Value).UsedRange
                .Cells.Copy
                .Cells.PasteSpecial xlPasteValues
                .Cells(1).Select
            End With
            Application.CutCopyMode = False

            'Save the new workbook and close it
            fName = Range("I11").Value
             'Change the date format to whatever you'd like, but make sure it's in quotes
            newFile = fName & " " & Format$(Date, "mm-dd-yyyy") & Columns("M:N").Select
            Selection.Delete Shift:=xlToLeft
            TempFilePath = directoryPath & sep
            TempFileName = "New File"

            With Destwb
                .SaveAs TempFilePath & TempFileName, FileFormat:=FileFormatNum
                .Close SaveChanges:=False
            End With

            MsgBox "You can find the new file in " & TempFilePath

            'With Application
            '    .ScreenUpdating = True
            '    .EnableEvents = True
            'End With


            'Application.Goto Sheets(cmbSheet.Value).[a22], True
            'Application.ScreenUpdating = False
            'Unload Me
        End If
    End If

THE_END:

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    Unload Me


End Sub