VBA: Move Named Sheets to New Workbook & Save-CodePudding

I found this code that works really great, but 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

CodePudding user response：

Please, test the next code:

Sub MoveSheets()
 Dim sPath As String, sAddress As String, wsCur As Worksheet
 Dim arrNoMoveSh, mtchSh

 arrNoMoveSh = Split("valid,control,data", ",") 'create an array of the sheets name to not be moved
 '-- Store path of this workbook --
 sPath = ThisWorkbook.path & Application.PathSeparator

  '-- Loop through worksheets --
 For Each wsCur In ThisWorkbook.Worksheets
      mtchSh = Application.match(wsCur.Name, arrNoMoveSh, 0)
      If IsError(mtchSh) Then 'no sheet names found in the array
          wsCur.Copy 'create a new workbook for the sheet to be copied!!!
          ActiveWorkbook.Close savechanges:=True, FileName:=sPath & wsCur.Name & ".xlsx"
     End If
 Next wsCur
End Sub