Sub RunMe() Dim ws As Worksheet Dim shName As String For Each ws In Worksheets If ws.Name <> "NMS" And ws.Name <> "MS" And _ ws.Name <> "Master" And ws.Name <> "Missing" Then ws.Select shName = ws.Name Workbooks.Add ThisWorkbook.ActiveSheet.Copy _ after:=ActiveWorkbook.Sheets(Sheets.Count) Application.DisplayAlerts = False Sheets("Sheet1").Delete Application.DisplayAlerts = True ThisWorkbook.Sheets("NMS").Copy _ after:=ActiveWorkbook.Sheets(Sheets.Count) ThisWorkbook.Sheets("MS").Copy _ after:=ActiveWorkbook.Sheets(Sheets.Count) ThisWorkbook.Sheets("Master").Copy _ after:=ActiveWorkbook.Sheets(Sheets.Count) ThisWorkbook.Sheets("Missing").Copy _ after:=ActiveWorkbook.Sheets(Sheets.Count) ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path _ & "\" & shName & ".xlsx" ActiveWorkbook.Close End If Next ws End Sub
DON'T MISS