Hi I have this workbook I use to edit data in one worksheet and then
save the edited data to a new worksheet with the tab color yellow.
The main worksheet is then cleared and ready to use again.
What I need to do is to move all the saved worksheets those with the
tab color yellow to a new workbook on my desktop I have a command
button set up to give me an Input box to name the new workbook.
It should work like this:

Command button clicked
Inputbox comes up Enter New workbook name
Click Ok
All yellow tabbed worksheets move to new workbook and delete
from main workbook.

Can it be done?

Thanks in advance
Charles


--
mrdata
------------------------------------------------------------------------
mrdata's Profile: http://www.excelforum.com/member.php...o&userid=17899
View this thread: http://www.excelforum.com/showthread...hreadid=519020

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

This didn't copy completely. Add the following after the last End If:


ErrorExit:
Set oWSH = Nothing

End Sub
'shown below

Regards,
GS


"GS" wrote:

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

ErrorExit:
Set oWSH = Nothing

End Sub


Regards,
GS

GS
Thanks man it works great however how can we delete the default 3
worksheets that are present in all new workbooks?
Sheet1 Sheet2 Sheet3

I'm sure it can be done

Thanks again
Charles


--
mrdata
------------------------------------------------------------------------
mrdata's Profile: http://www.excelforum.com/member.php...o&userid=17899
View this thread: http://www.excelforum.com/showthread...hreadid=519020

GS

I added this line to the code

Application.SheetsInNewWorkbook = 1

Now that the new workbook contains the newly moved worksheets and one
default worksheet Sheet1

I want delete Sheet1

and sort the newly moved worksheets

The sheet names are week ending dates ie: 2-04-06 and so on

They display like this in the new workbook:

3-04-06
2-25-06
2-18-06
2-11-06
2-4-06
Sheet1

I would like them to display like this:

2-4-06
2-11-06
2-18-06
2-25-06
3-04-06

Thaks for the help
Charles


--
mrdata
------------------------------------------------------------------------
mrdata's Profile: http://www.excelforum.com/member.php...o&userid=17899
View this thread: http://www.excelforum.com/showthread...hreadid=519020

Hi mrdata,

I'm glad it works for you. Sorry about the sheets order, and not mentioning
about the number of sheets in the new book. You can change the order of how
they stack in the new workbook by changing this line:

If wks.Tab.ColorIndex = 36 Then wks.Move befo=wbkTarget.Sheets(1)

to this:

If wks.Tab.ColorIndex = 36 Then wks.Move _
after:=wbkTarget.Sheets(wbkTarget.Sheets.Count)


To delete the default sheet, change the "With wbkTarget" block as follows:

With wbkTarget
.sheets("Sheet1").Delete
.SaveAs sPath & "\" & sName
.Close
End With


You could avoid the resulting unwanted sheet(s) by putting the sheets in an
array, like this:

Sheets(Array("2-4-06", "2-11-06", "2-18-06", "2-25-06")).Move

This is what happens when you select a group of sheets and use the Move or
Copy... dialog. Alternatively, you could select the sheets manually (since
there's only a few) and use ActiveWindow.SelectedSheets.Move in place of
the Workbooks.Add method. This will work as long as your not moving all the
sheets in the active workbook. There must be at least one sheet left in the
workbook using this method. Since that will always be your "master" sheet, it
should work.

This would be better if you can live with pre-selecting the sheets to move
before running the macro, because:
1. The tab color factor is not an issue so it will work with any version of
Excel.
2. The sheet order will be however you want by just arranging the sheets in
whatever order before grouping them.

To group sheets, select the first one's tab then, while holding down the
Shift key, select the last one's tab. (assumes they are arranged
consecutive, otherwise use the 'Ctrl' key)

Here's the code:


Sub MoveGroupedSheets()
' This moves a pre-selected group of sheets into a new workbook,
' then saves it on the Desktop, and closes it.

Dim wbkTarget As Workbook
Dim sName As String, sPath As String
Dim oWSH As Object

sName = InputBox("Enter a filename")

If sName < "" Then
Application.ScreenUpdating = False

'Move the sheets to wbkTarget
ActiveWindow.SelectedSheets.Move

'Get a reference to the new workbook.
'(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

ErrorExit:
Set oWSH = Nothing
End Sub


Regards,
GS

GS

Hey man that's exactly what I wanted it to do great job!
One more thing Can I keep the default messagebox from popping up
When I delete the default Sheet1

It says data may exist in the sheet(s) selected for deletion. To
permanently delete the data,press Delete.
With the command buttons Delete and Cancel

It may confuse someone into thinking a sheet in the main workbook is
going to be deleted.

With wbkTarget
..Sheets("Sheet1").Delete
..SaveAs sPath & "\" & sName
..Close
End With

How do I alter the code to prevent the msgbox

Thanks again for the great help

Charles


--
mrdata
------------------------------------------------------------------------
mrdata's Profile: http://www.excelforum.com/member.php...o&userid=17899
View this thread: http://www.excelforum.com/showthread...hreadid=519020

Hi Charles,

You can suppress the message by wrapping the line to delete the sheet in
these statements, as follows:

Application.DisplayAlerts = False
'delete sheet
Application.DisplayAlerts = True

Regards,
GS

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

Oops! -I forgot to include the version notification. See below where to add it.

Regards,
GS

"GS" wrote:

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
********************
Else
MsgBox "This macro requires Excel v10 or higher ! ", vbExclamation
+ vbOKOnly
Exit Sub
********************
End If

ErrorExit:
Set oWSH = Nothing
End Sub


Regards,
GS