Repeated saving to a workbook

[Apple08]

Hi everyone

I have the following code, however I noticed a message keep prompting that a workbook has been saved twice and asked whether the old workbook should be replaced. I noticed there are duplicate code in my macro (the red and blue bits), however, if I deactivate the red bit, it stopped the new file to replace the old file message, but blue bit doesn't work. If I deactivate the blue bit, the message appears again.

Please could anyone tell me how to adjust the code. Any help would be appreciated.

Sub D_createModuleWorkbooks()

Dim wSheet As Worksheet
Dim intResult As Integer
Dim strPath As String
Dim countItems As Integer
Application.ScreenUpdating = False
'Creates a module workbook for every worksheet in the log and inventory workbook
'Dialogue box opens to tell the user that they are going to be asked to chose where they want to save the workbooks
answer = MsgBox("A workbook will now be created for each of the modules in your log and inventory workbook. Next, you will be asked to select where you want to save the files. After you have selected your folder and clicked OK, the folders will be created and a message box will tell you when the process is complete. Do you want to proceed?", vbYesNo)
If answer = vbNo Then Exit Sub
'A dialog box is displayed to the user where a folder is selected into which _
the module workbooks are to be saved
intResult = Application.FileDialog(msoFileDialogFolderPicker).Show
'checks if user has cancled the dialog
If intResult <> 0 Then
    
'Message box is displayed showing where the workbboks have been saved to
Call MsgBox(Application.FileDialog(msoFileDialogFolderPicker _
    ).SelectedItems(1), , "You have chosen the following folder to save your workbooks")
strPath = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)
End If
'A workbook is created for each module in the log and inventory workbook
For Each wSheet In ActiveWorkbook.Worksheets
    wSheet.Activate
    sheet1name = Sheets(1).Name
    countItems = Application.WorksheetFunction.CountIfs(Range("G:G"), "s")
    If wSheet.Name <> sheet1name And wSheet.Name <> "Templates" Then
        If countItems > 0 Then
        wSheet.Select
        
'To copy worksheets to individual module schedule workbook

        Dim wsSheet As Worksheet
        Dim wsSheet1 As Worksheet
       [COLOR=#ff0000] Worksheets("Templates").Select False
            ActiveWindow.SelectedSheets.Copy
            ActiveWorkbook.SaveAs Filename:= _
                strPath & "\" & wSheet.Name & ".xlsm", FileFormat:=52
            ActiveWindow.Close[/COLOR]
        On Error Resume Next
        Set wsSheet = Sheets("SPM Prompts")
'        On Error GoTo 0
        If Not wsSheet Is Nothing Then
            Worksheets(Array("Templates", "Module Pres Specification", "SPM Prompts")).Select False
            ActiveWindow.SelectedSheets.Copy
            ActiveWorkbook.SaveAs Filename:= _
                strPath & "\" & wSheet.Name & ".xlsm", FileFormat:=52
            ActiveWindow.Close
        On Error Resume Next
        Set wsSheet1 = Sheets("Module Pres Specification")
'        On Error GoTo 0
        ElseIf wsSheet Is Nothing Then
            Worksheets(Array("Templates", "Module Pres Specification")).Select False
            ActiveWindow.SelectedSheets.Copy
            ActiveWorkbook.SaveAs Filename:= _
                strPath & "\" & wSheet.Name & ".xlsm", FileFormat:=52
            ActiveWindow.Close
        [COLOR=#0000ff]ElseIf wsSheet And wsSheet1 Is Nothing Then
            Worksheets("Templates").Select False
            ActiveWindow.SelectedSheets.Copy
            ActiveWorkbook.SaveAs Filename:= _
                strPath & "\" & wSheet.Name & ".xlsm", FileFormat:=52
            ActiveWindow.Close[/COLOR]
          
        End If
        End If
        End If
    
Next wSheet
'A message box tells the user that the process is complete
Application.ScreenUpdating = True
MsgBox "Your workbooks have been created in " & strPath, vbOKOnly
End Sub

 

[Apple08]

Hi, I wonder can anyone help please?