Create a new Worksheet with a few Twists

[Sean]

I could I do the following via code:-

1) Create a blank sheet to the very right of existing worksheets in a
file, these will change e.g by adding blank sheets etc
2) Copy the contents of the entire sheet to the 'left' to this new
sheet
2) Rename this blank sheet with text "Loc # 5" the number I have here
is variable, so to work out what number to use you could add the
number of existing sheets and subtract 2. What I mean by this is my
3rd sheet is named "Loc # 1", 4th sheet is named "Loc # 2"
3) Change the tab colour on the sheet based on the sheet numbers
'number'. Odd numbers would be coloured blue and even numbered sheets
yellow. What I mean here, eg. my 3rd sheet which is named 'Loc # 1"
has a blue colour tab etc

Hope the above makes sense, I can do it all manually but looking to
automate the task

Thanks

 

[Dan R.]

I could I do the following via code:-

1) Create a blank sheet to the very right of existing worksheets in a
file, these will change e.g by adding blank sheets etc
2) Copy the contents of the entire sheet to the 'left' to this new
sheet
2) Rename this blank sheet with text "Loc # 5" the number I have here
is variable, so to work out what number to use you could add the
number of existing sheets and subtract 2. What I mean by this is my
3rd sheet is named "Loc # 1", 4th sheet is named "Loc # 2"
3) Change the tab colour on the sheet based on the sheet numbers
'number'. Odd numbers would be coloured blue and even numbered sheets
yellow. What I mean here, eg. my 3rd sheet which is named 'Loc # 1"
has a blue colour tab etc

Hope the above makes sense, I can do it all manually but looking to
automate the task

Thanks

Try this:

Sub Test()
Set ws = Sheets.Add(after:=Sheets(Sheets.Count))
ws.Name = "Loc # " & Sheets.Count - 2
Sheets(Sheets.Count - 1).UsedRange.Copy ws.Range("A1")

If Right(ws.Name, 1) Mod 2 = 0 Then
ws.Tab.ColorIndex = 5
Else
ws.Tab.ColorIndex = 6
End If
End Sub

 

[sebastienm]

Hi
Try the following. On the last row of code, you need to change the number 10
and 20 which correspond to the color index for the sheet tabs. Replace 10 by
the colorIndex for Even sheets and 20 by the one for odd sheets.

Sub ProcessNewSHeet()

Dim wbk As Workbook
Dim nWorksheets As Long ''' number of worksheets
Dim WshToCopy As Worksheet
Dim NewWsh As Worksheet

Set wbk = ActiveWorkbook
nWorksheets = wbk.Worksheets.Count
Set WshToCopy = wbk.Worksheets(nWorksheets)

''' duplicate the last sheet
WshToCopy.Copy After:=WshToCopy

''' get variables
nWorksheets = wbk.Worksheets.Count
Set NewWsh = wbk.Worksheets(nWorksheets)

''' rename
NewWsh.Name = "Loc # " & (nWorksheets - 2)

''' color tab <<<<< CHANGE NUMBERS 10 and 20 BELLOW
NewWsh.Tab.ColorIndex = IIf(((nWorksheets - 2) Mod 2) = 0, 10, 20)
''' meaning: if even then 10 else 20

End Sub

 

[Joel]

It looks like you just need to copy the worksheet, change name, and then
change tab color. Don't need to first create new worksheet.

Sub copysheet()

sheetname = ActiveSheet.Name
sheetnumber = Val(Trim(Mid(sheetname, InStr(sheetname, "#") + 1)))
sheetnumber = sheetnumber + 1
sheetprefix = Trim(Left(sheetname, InStr(sheetname, "#")))
ActiveSheet.Copy after:=Sheets(ActiveSheet.Index)
ActiveSheet.Name = sheetprefix & sheetnumber
If sheetnumber Mod 2 = 0 Then
ActiveSheet.Tab.ColorIndex = 41
Else
ActiveSheet.Tab.ColorIndex = 6
End If
End Sub

 

[Sean]

Dan that is superb, spot on.

One question how can I get a number for all the colours, the 'blue'
colour isn't quite the blue I want?

Thanks

 

[Sean]

Thanks Joel for your post, I've a few more tweaks which I want to add,
more later

Thanks

 

[Sean]

Joel, one thing on your code is that it renames as "Loc #13" - number
13 used as an example, but my previous sheet is named "Loc # 12" -
note the space between # and 12. Howcan I achieve the space on the new
sheet also?