Macro Help - Parse Worksheet Name

[jacodri]

I'm Trying to create a macro that will save each worksheet as the tab name instead of saving the file as "Sheet#". What am I missing in the code below?

Sub SaveShtsAsBook()
    Dim Sheet As Worksheet, Sheet$, MyFilePath$, N&
    MyFilePath$ = ActiveWorkbook.Path & "U:\Clients\Current\Fresenius\4996_FMCNA_2016_Clincial Managers Conference\Lists_Registration\Rooming List\Master Rooming List" & _
    Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 9)
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
         '      End With
        On Error Resume Next '<< a folder exists
        MkDir MyFilePath '<< create a folder
        For N = 1 To Sheets.Count
            Sheets(N).Activate
            SheetName = ActiveSheet.Name
            Cells.Copy
            Workbooks.Add (xlWBATWorksheet)
            With ActiveWorkbook
            With .ActiveSheet
                    .Paste
                    .Name = SheetName
                    [A1].Select
                End With
                 'save book in this folder
                .SaveAs Filename:=MyFilePath _
                & "U:\Clients\Current\Fresenius\4996_FMCNA_2016_Clincial Managers Conference\Lists_Registration\Rooming List\Master Rooming List" & SheetName & ".xls"
                .Close SaveChanges:=True
            End With
            .CutCopyMode = False
        Next
    End With
    Sheet1.Activate
End Sub

 

[RickXL]

Hi and welcome to the MrExcel Message Board.

This line does not look right:

.SaveAs Filename:=MyFilePath _
                & "U:\Clients\Current\Fresenius\4996_FMCNA_2016_Clincial Managers Conference\Lists_Registration\Rooming List\Master Rooming List" & SheetName & ".xls"

MyFilePath is already set to a long string at the start of the code:

ActiveWorkbook.Path & "U:\Clients\Current\Fresenius\4996_FMCNA_2016_Clincial Managers Conference\Lists_Registration\Rooming List\Master Rooming List" & _
    Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 9)

In fact, that already has a path joined to a path.

It will help if you replace:

        On Error Resume Next '<< a folder exists
        MkDir MyFilePath '<< create a folder

with this:

        On Error Resume Next '<< a folder exists
        MkDir MyFilePath '<< create a folder
        On Error GoTo 0 '<< cancel error override

It won't make your program run but it will show you where the errors are.

Regards,