Sheet Copying

[pells]

I have a workbook with many worksheets. I am trying to copy all of the worksheet where the Tab.ColorIndex = 4 via code, but am completely stuck.

Does anyone know or able to help me where if the Tab.ColorIndex = 4 across any of the sheets then copy this sheet to a new workbook. There will be many worksheets where the Tab.ColorIndex = 4, so I need to code to be able to find all of them and copy the sheet as well as the tab name? I can copy the sheets successfully if I manually name my code to reflect the sheet names but the code is too long and if the sheetname changes, the code fails.

Many thanks for taking the time to read my post and many thanks for any help/assistance that can be given.

 

[VoG]

Try this: Note that it doesn't save the workbook containing the copied sheets

Sub a()
Dim i As Long, Got As Boolean
For i = 1 To Sheets.Count
    If Sheets(i).Tab.ColorIndex = 4 Then
        If Got Then
            Sheets(i).Select Replace:=False
        Else
            Got = True
            Sheets(i).Select
        End If
    End If
Next i
If Got Then ActiveWindow.SelectedSheets.Copy
End Sub

 

[pells]

Try this: Note that it doesn't save the workbook containing the copied sheets

Sub a()
Dim i As Long, Got As Boolean
For i = 1 To Sheets.Count
    If Sheets(i).Tab.ColorIndex = 4 Then
        If Got Then
            Sheets(i).Select Replace:=False
        Else
            Got = True
            Sheets(i).Select
        End If
    End If
Next i
If Got Then ActiveWindow.SelectedSheets.Copy
End Sub

Many thanks for this. This seems to copy where the Tab.ColorIndex = 4 to a new workbook, but I want the code so that is pastes where the Tab.ColorIndex = 4 to a workbook that I want it to goto.

So the code is in my new workbook, when a button is pressed, it opens up the old workbook, finds the first sheet where the Tab.ColorIndex = 4 and then copies it to the new workbook, then it finds the next worksheet where the Tab.ColorIndex = 4 and then copies it to the new workbook and so on until it doesnt find any more sheets to copy........

Can your code be modified to do this?

I hope this makes sense and once again, many thanks for your help.

 

[VoG]

Try this : change the part in red to the name of the destination workbook (which must be open). The code goes in a regular module in the source workbook

Sub a()
Dim i As Long, wb As Workbook
Set wb = Workbooks("Book3.xlsm")
With ThisWorkbook
    For i = 1 To .Sheets.Count
        If .Sheets(i).Tab.ColorIndex = 4 Then .Sheets(i).Copy after:=wb.Sheets(Sheets.Count)
    Next i
End With
End Sub

 

[pells]

Try this : change the part in red to the name of the destination workbook (which must be open). The code goes in a regular module in the source workbook

Sub a()
Dim i As Long, wb As Workbook
Set wb = Workbooks("Book3.xlsm")
With ThisWorkbook
    For i = 1 To .Sheets.Count
        If .Sheets(i).Tab.ColorIndex = 4 Then .Sheets(i).Copy after:=wb.Sheets(Sheets.Count)
    Next i
End With
End Sub

Thanks for this.

Is it possible for the code to work the other way around so that the code is in the new workbook and then copy from the source workbook?

The reason being is that there will be many users already using the source workbook so we wont be able to put the code into the workbook they will be using but into a new one, so when they receive the new updated workbook, they will be able to import from the one that they have been using i.e the source workbook.

I hope this makes sense?

 

[VoG]

With the code in the destination workbook try

Sub a()
Dim i As Long, wb As Workbook
Set wb = Workbooks("Book1.xlsm")
With wb
    For i = 1 To .Sheets.Count
        If .Sheets(i).Tab.ColorIndex = 4 Then .Sheets(i).Copy after:=ThisWorkbook.Sheets(Sheets.Count)
    Next i
End With
End Sub

Book1.xlsm is the source workbook: change to suit.

 

[pells]

I have tried this, but this creates new sheets in the new workbook as opposed to copying to the same sheet with the same name - any ideas?

 

[VoG]

I have tried this but as there are no sheets that Tab.ColorIndex = 4, nothing is copied.

Um, isn't that obvious. I thought that was your criterion for copying.

 

[pells]

Um, isn't that obvious. I thought that was your criterion for copying.

I realised what I said after I posted it and changed my post to read:

I have tried this, but this creates new sheets in the new workbook as opposed to copying to the same sheet with the same name - any ideas?

My criterion is:

If my current worksheet has a tab index colour of 4, then copy it to my new workbook with the same tab name. If the tab index colour is not 4, then do nothing.

Currently this code doesnt copy into my new workbook, but the current one.

Apologies.

 

[VoG]

Do you want to overwrite the sheets in the destination workbook or to append?