Creating New Workbooks from A Range

[ludlow]

Greetings,
I found myself needing assistance once again. I have a workbook where the user is able to create multiple copies of one worksheet (master), which is based from a range (Emp_Names). The range is located on the Homepage worksheet. The issue I am having has to do with creating individual workbooks for each newly created worksheet (Emp_Names) and saving them as based off the employee name that was entered in the range (Emp_Names). Any assistance would be greatly appreciated.

Here is the first macro used to create the new worksheets...

Sub CopySheets()
Dim FinalRow As Long
Dim WsEmp As Worksheet


Set WsEmp = Worksheets("Homepage")
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row


    Application.ScreenUpdating = False
        '-----------------------------------------------------------
        'This section add the number of EMPL worksheets as needed
        '-----------------------------------------------------------
        
        Dim sh As Worksheet
        Dim tabname As Range
            
        For Each tabname In Sheets("Homepage").Range("Emp_Names")
        
            If tabname.Value <> "" Then
            
            Set sh = Nothing
            On Error Resume Next
            Set sh = Worksheets(tabname.Value)
            On Error GoTo 0
            If sh Is Nothing Then
            
            Worksheets("MASTER").Copy After:=Worksheets("master")
            ActiveSheet.Name = tabname.Value
            End If
        End If
        Next tabname
        Worksheets("Homepage").Activate
    Application.ScreenUpdating = True
End Sub

 

[ludlow]

I was able to figure it out. The code is below in case someone needs it in the future.

Sub CreateNewWBS()
Dim wbThis As Workbook
Dim wbNew As Workbook
Dim ws As Worksheet
Dim strFilename As String


    Set wbThis = ThisWorkbook
    For Each ws In wbThis.Worksheets
        If ws.Name <> ActiveSheet.Name And ws.Name <> "Master" Then
           strFilename = wbThis.Path & "/" & ws.Name
           ws.Copy
           Set wbNew = ActiveWorkbook
           wbNew.SaveAs strFilename
           wbNew.Close
         End If
    Next ws
End Sub