Moving unknown sheets to new workbook

[preetx2]

I want to move multiple sheets to new workbook. Currently, I am using the code posted below and it works just fine. However, its limited. Is there a way, Where I can count the sheets in the workbook first, then run the code to generate new worksheets and move only newly generated sheets to new workbook? Basically, I am trying to avoid listing the name of all sheets.

sub move()
Dim w As Workbook, ws As Worksheet, ss As Worksheet
For Each ws In ThisWorkbook.Worksheets
If ws.CodeName <> "Sheet1" And ws.CodeName <> "Sheet2" And ws.CodeName <> "Sheet3" And ws.CodeName <> "Sheet4" And ws.CodeName <> _
"Sheet5" And ws.CodeName <> "Sheet6" And ws.CodeName <> "Sheet7" And ws.CodeName <> "Sheet8" And ws.CodeName <> "Sheet9" And ws.CodeName <> _
"Sheet10" And ws.CodeName <> "Sheet11" And ws.CodeName <> "Sheet12" And ws.CodeName <> "Sheet13" And ws.CodeName <> "Sheet14" And ws.CodeName <> "Sheet15" And ws.CodeName <> _
"Sheet16" And ws.CodeName <> "Sheet17" And ws.CodeName <> "Sheet18" And ws.CodeName <> "Sheet19" And ws.CodeName <> "Sheet20" And ws.CodeName <> "Sheet21" And ws.CodeName <> "Sheet22" Then


If w Is Nothing Then
ws.move


Set w = ActiveWorkbook
Else
ws.move After:=ss
End If
Set ss = ActiveSheet
End If
Next ws
Sheets(1).Select
ThisWorkbook.Activate
end sub()

 

[Grasor]

It occurred to me just now that since you are 'moving' the new sheets to another workbook the loop I provided wouldn't work as with each execution the number of sheets in the workbook would decrease. Thus you would need to adjust for that:

Dim iStart, iStop, iSheet as Integer

iSheet = ThisWorkBook.Sheets.Count + 1

'Execute Code to Create Your New Sheets

iStop = ThisWorkBook.Sheets.Count

For iStart = iSheet to iStop
     'Execute Code to move Sheets
     'Reference Sheets(iSheet) each time
next iStart


'The intent is to loop through as many times as necessary to get all the newly created sheets moved but you are always moving the sheet at the same position in the workbook.

-G