Excel VBA - Create new files for each worksheet in a workbook (except for one)

[juliard]

Hi All,

Long time lurker first time posting. I have workbook with the following specs and macros:

WS named Master (here I paste my data base) this takes into account the information that is included in column L and copies specific information into the worksheet that is named after the information in said column

Sub Separar_Proveedores()
Dim i, LastRow


LastRow = Sheets("Master").Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To LastRow




If Sheets("Master").Cells(i, "L").Value = "S" Then
Sheets("Master").Cells(i, "L").EntireRow.Copy Destination:=Sheets("S").Range("A" & Rows.Count).End(xlUp).Offset(1)
End If


If Sheets("Master").Cells(i, "L").Value = "H" Then
Sheets("Master").Cells(i, "L").EntireRow.Copy Destination:=Sheets("H").Range("A" & Rows.Count).End(xlUp).Offset(1)
End If


If Sheets("Master").Cells(i, "L").Value = "M" Then
Sheets("Master").Cells(i, "L").EntireRow.Copy Destination:=Sheets("M").Range("A" & Rows.Count).End(xlUp).Offset(1)
End If


Next i
End Sub


The second macro creates files for each one of the worksheets in the workbook and saves them in the same location, what I want is to EXCLUDE the worksheet named "MASTER" so that the macro does not create a workbook for this sheet and also i'd like to add the date (day-month-year dd-mmm-yyy) in the name of the file that's being created.


Sub Create_files()
Dim xPath As String
xPath = Application.ActiveWorkbook.Path
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each xWs In ThisWorkbook.Sheets
xWs.Copy
Application.ActiveWorkbook.SaveAs Filename:=xPath & "" & xWs.Name & ".xls"
Application.ActiveWorkbook.Close False
Next
Application.DisplayAlerts = True
Application.ScreenUpdating = True




End Sub

I'm thinking that i can add something like this: Format(Now, "Mmm-yyyy")to the name of the workbook I'm just having issues with the right place to put it
and I have NO Clue as to how to exclude the worksheet Master from the range.

Any and all help will be appreciated!

Thank you!!!

Julia

 

[Warship]

Try:

Sub Create_files()
    Dim xPath As String
    
    Dim xWs As Variant
    
    xPath = Application.ThisWorkbook.Path
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    For Each xWs In ThisWorkbook.Sheets
        If xWs.Name <> "Master" Then
            Workbooks.Add
            With Application.ActiveWorkbook
                xWs.Copy Before:=.Sheets(1)
                .SaveAs Filename:=xPath & "\" & xWs.Name & " " & Format(Now, "mmm-yyyy") & ".xls", FileFormat:=xlExcel8
                .Close False
            End With
        End If
    Next
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

 

[juliard]

Hi Warship

Thank you!!
it worked perfectly!