Hi Charles,

Here's a better solution. It will group the sheets with colored tabs, then
move them into a new workbook containing only the grouped sheets. Replace
everything else with this code:

Sub GroupSheetsToNewBook()
' This moves grouped sheets with a specified tab color into a new workbook,
' containing only the grouped sheets,
' then saves it on the Desktop, and closes it.
'
' Tab colors were new in version 10
' It will notify the user and exit if a lower version.

Dim wks As Worksheet, wbkSource As Workbook, wbkTarget As Workbook
Dim sName As String, sPath As String, Shts() As String
Dim oWSH As Object
Dim i As Integer
Dim bSheetsToMove As Boolean

If Val(Application.Version) 9 Then
sName = InputBox("Enter a filename")

If sName < "" Then
Application.ScreenUpdating = False

i = 0
For Each wks In ActiveWorkbook.Worksheets
'**Change the ColorIndex value to suit your color.
If wks.Tab.ColorIndex = 36 Then
'fill the array with names
ReDim Preserve Shts(0 To i)
Shts(i) = wks.Name
i = i + 1
bSheetsToMove = True
End If
Next
If Not bSheetsToMove Then
MsgBox "No sheets to move!", vbExclamation + vbOKOnly
Exit Sub
End If

'move the sheets into wbkTarget
ActiveWorkbook.Worksheets(Shts).Move

'(Since it is now the active workbook, this is optional)
Set wbkTarget = ActiveWorkbook

'Save it to the desktop with the name provided
On Error GoTo ErrorExit
Set oWSH = CreateObject("WScript.Shell")
sPath = oWSH.SpecialFolders("Desktop")

With wbkTarget '(or ActiveWorkbook)
.SaveAs sPath & "\" & sName
.Close
End With
End If
End If

ErrorExit:
Set oWSH = Nothing
End Sub


Regards,
GS