View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
GS GS is offline
external usenet poster
 
Posts: 364
Default Move worksheets to a new workbook

Try this:

Sub MoveSavedSheets()
' This moves sheetswith a specified tab color into a new workbook,
' and 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
Dim oWSH As Object

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

If sName < "" Then
Set wbkSource = ActiveWorkbook
Application.ScreenUpdating = False
Set wbkTarget = Workbooks.Add

'Move the sheets to wbkTarget
'**Change the ColorIndex value to suit your color.
'**To obtain this, record a macro and select the color.
For Each wks In wbkSource.Sheets
If wks.Tab.ColorIndex = 36 Then wks.Move befo=wbkTarget.Sheets(1)
Next

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

With wbkTarget
.SaveAs sPath & "\" & sName
.Close
End With
End If
Else
MsgBox "This macro requires Excel v10 or higher ! ", vbExclamation +
vbOKOnly
Exit Sub
End If

Regards,
GS