Copy only a few sheets from workbook

Greetings

I have 16 Sheets in my workbook, I only want to copy 12 of them to a new workbook.

I am creating new workbooks based on the code below but its coping all 16 sheets.

the 12 sheets are named Jan through Dec

Sub copy()

Dim i As Integer
'Dim j As Integer

Dim employeeName As String, path As String, year As String

If MsgBox("This will save files in assigned folder. Continue?" _
    , vbOKCancel, "Prompt") = vbCancel Then Exit Sub
        
year = Range("A1").Value
path = Range("A2").Value

Application.ScreenUpdating = False

For i = 1 To 27

Application.StatusBar = "Progress..: " & i & "/" & 8

employeeName = Cells(i + 2, 1)

Application.DisplayAlerts = False
If Dir(path & year, vbDirectory) = "" Then MkDir (path & year)

ActiveWorkbook.SaveAs Filename:=path & year & "\" & employeeName & ".xls"

Next

ActiveWorkbook.SaveAs Filename:=path & "SupervisorMasterControl.xls"

Application.DisplayAlerts = True
Application.StatusBar = "Updating links..."


Application.StatusBar = False      'return control to Excel
Application.ScreenUpdating = True

End Sub

I have 27 employees identified on Sheet1,A3:A30

and this creates 27 new workbooks for them including the 4 extra sheets I dont want/need them to see.

Would it be easier to create a second "Employee.xls" workbook and have it contain ONLY the 12 sheets? if so, how would I alter this code to allow for that?

I perfer to keep only a single workbook master but either way will work.

Any clues?

Update in color with answers match color in code.

Still 3 &4

Thanks again for the nudge in the right direction..

I have a few more questions.

The code below is working fine for me. Its amazing to watch it run.. I keep deleting the final product and re-running the macro just to see it run again!

Anyhow..

1. How would I change the code below to loop only the number of times needed for the actual number of employees in column A of Sheet1?

Right now it loops 26 times..

2. How can I check for the existance of the Path and create it if it does not exist? Done!

3. If the path exists, and the macro is running, if it encounters an employee's file already there, give the user the option to over-write the file or skip to the next. Over-write query is automatic, but any input other than YES will break the code, I think I need "ONERR" as well?

4. Is there a way to clean this up and maybe shorten up the code? Arrays? or something else? there seems to still be plenty of repeated steps that may be changed to variables or "Dim" I think..

Sub New_Sheets()
    
Dim Year1 As Integer
Dim Year2 As Integer
Dim i As Integer
Dim J As Integer
Dim ws As Worksheet
Dim wsListings As Worksheet
Dim wb As Workbook
Dim eName As String
Dim Path As String
Dim Year As String

'grabs the new directory path and year
    Year = ThisWorkbook.Sheets("MASTER EDIT").Range("I13").Value
    Path = ThisWorkbook.Sheets("MASTER EDIT").Range("I11").Value

'Check to see if the directory exists, if not, make it
If Len(Dir(Path & Year, vbDirectory)) = 0 Then
    MkDir Path & Year
End If
'Adjust the master sheets for the indicated fiscal year and adds a year for the first quarter of the next
'this needs to happen only once so its stays out of the looping areas

        Year1 = ThisWorkbook.Sheets("Sheet1").Range("A1").Value
        Year2 = Year1 + 1
        Sheets("YEAR TOTAL").Cells(15, 1).Value = "" & Year1 & " / " & Year2
        Sheets("APR").Cells(2, 7).Value = "" & Year1
        Sheets("MAY").Cells(2, 7).Value = "" & Year1
        Sheets("JUN").Cells(2, 7).Value = "" & Year1
        Sheets("JUL").Cells(2, 7).Value = "" & Year1
        Sheets("AUG").Cells(2, 7).Value = "" & Year1
        Sheets("SEP").Cells(2, 7).Value = "" & Year1
        Sheets("OCT").Cells(2, 7).Value = "" & Year1
        Sheets("NOV").Cells(2, 7).Value = "" & Year1
        Sheets("DEC").Cells(2, 7).Value = "" & Year1
        Sheets("JAN").Cells(2, 7).Value = "" & Year2
        Sheets("FEB").Cells(2, 7).Value = "" & Year2
        Sheets("MAR").Cells(2, 7).Value = "" & Year2
    
 'Tell the user whats going to happen
 If MsgBox("This will save files in assigned folder. Continue?" _
    , vbOKCancel, "Prompt") = vbCancel Then Exit Sub
 
 'Assuming your employee names are in cells A3 to A29 in sheet "Sheet1".
    Set wsListings = ThisWorkbook.Sheets("Sheet1")
    'For i = 4 To 29
 For i = 4 To Range("B" & Rows.Count).End(xlUp).Row
      'Finds the employee name
    eName = wsListings.Range("A" & i).Value
    
 'Changes the Master Sheets for the current employee name
 
    Sheets("YEAR TOTAL").Cells(1, 1).Value = "" & eName
    Sheets("APR").Cells(1, 1).Value = "" & eName
    Sheets("MAY").Cells(1, 1).Value = "" & eName
    Sheets("JUN").Cells(1, 1).Value = "" & eName
    Sheets("JUL").Cells(1, 1).Value = "" & eName
    Sheets("AUG").Cells(1, 1).Value = "" & eName
    Sheets("SEP").Cells(1, 1).Value = "" & eName
    Sheets("OCT").Cells(1, 1).Value = "" & eName
    Sheets("NOV").Cells(1, 1).Value = "" & eName
    Sheets("DEC").Cells(1, 1).Value = "" & eName
    Sheets("JAN").Cells(1, 1).Value = "" & eName
    Sheets("FEB").Cells(1, 1).Value = "" & eName
    Sheets("MAR").Cells(1, 1).Value = "" & eName
     
'creates a new workbook
    Set wb = Workbooks.Add
    
'This copies the sheets 3 at a time to the new workbook
'dont change the format below as the deletion sequence will reverse the sheets for some reason
    
    ThisWorkbook.Sheets(Array("JAN", "FEB", "MAR")).copy wb.Sheets(1)
    ThisWorkbook.Sheets(Array("OCT", "NOV", "DEC")).copy wb.Sheets(1)
    ThisWorkbook.Sheets(Array("JUL", "AUG", "SEP")).copy wb.Sheets(1)
    ThisWorkbook.Sheets(Array("APR", "MAY", "JUN")).copy wb.Sheets(1)
    ThisWorkbook.Sheets(Array("YEAR TOTAL")).copy wb.Sheets(1)

'This deletes other sheets we dont need (Sheet1 Sheet2 Sheet3) from the newly created workbook
    For J = wb.Sheets.Count To 14 Step -1
        Application.DisplayAlerts = False
        wb.Sheets(J).Delete
        Application.DisplayAlerts = True
'loops this deletion sequence until only 13 sheets are left 14-1
    Next J
    
'saves and close the workbook as the employee's name after its been modified
    wb.SaveAs Path & Year1 & "\" & eName & ".xls"
    wb.Close True
    
'begins again to get the next employee's name
Next i

'ends the entire routine
End Sub

Cheers
Aurbo