VBA: Move Named Sheets to New Workbook & Save

[NewBlood]

I found this code in this forum and I was hoping someone could walk me through how I can move sheets that are not named valid, control, and data. The 3 named sheets are my constants and do not need them moved.

Option Explicit

Sub MoveSheets()
Dim sPath As String
Dim sAddress As String
Dim wbCur As Workbook
Dim wsCur As Worksheet

'-- Store path of this workbook --
sPath = ThisWorkbook.Path & Application.PathSeparator

'-- Loop thru worksheets --
For Each wsCur In ThisWorkbook.Worksheets
    On Error Resume Next
    Set wbCur = Nothing
    '-- Add a new workbook --
    Set wbCur = Workbooks.Add
    On Error GoTo 0
    If wbCur Is Nothing Then
        '-- Report any error --
        MsgBox prompt:=Err.Description
    Else
        '-- Rename sheet 1 of new workbook --
        wbCur.Sheets(1).Name = wsCur.Name
        '-- Get range address of input data --
        sAddress = wsCur.UsedRange.Address
        '-- Copy & paste data --
        wsCur.UsedRange.Copy Destination:=wbCur.Sheets(1).Range(sAddress)
        '-- Save new workbook with filename = current worksheet name --
        wbCur.Close savechanges:=True, Filename:=sPath & wsCur.Name & ".xlsx"
    End If
Next wsCur
End Sub

 

[rlv01]

Not tested.

Sub MoveSheets()
    Dim sPath As String
    Dim sAddress As String
    Dim wbCur As Workbook
    Dim wsCur As Worksheet
    
    '-- Store path of this workbook --
    sPath = ThisWorkbook.Path & Application.PathSeparator
    
    '-- Loop thru worksheets --
    For Each wsCur In ThisWorkbook.Worksheets
        Select Case wsCur.Name
            Case "valid", "control", "data" 'worksheet exclude list
            Case Else
                On Error Resume Next
                Set wbCur = Nothing
                
                '-- Add a new workbook --
                Set wbCur = Workbooks.Add
                On Error GoTo 0
                
                If wbCur Is Nothing Then
                    '-- Report any error --
                    MsgBox prompt:=Err.Description
                Else
                    '-- Rename sheet 1 of new workbook --
                    wbCur.Sheets(1).Name = wsCur.Name
                    
                    '-- Get range address of input data --
                    sAddress = wsCur.UsedRange.Address
                    
                    '-- Copy & paste data --
                    wsCur.UsedRange.Copy Destination:=wbCur.Sheets(1).Range(sAddress)
                    
                    '-- Save new workbook with filename = current worksheet name --
                    wbCur.Close savechanges:=True, Filename:=sPath & wsCur.Name & ".xlsx"
                End If
        End Select
    Next wsCur
End Sub