New one
Sub InsertNewSheetDON()
Dim oldsht As String
Dim newname As String
Dim s As Worksheet
Application.ScreenUpdating = False
oldsht = ActiveSheet.Name
newname = InputBox("name sheet")
For Each s In Sheets
'checks for sht
If s.Name = newname Then
MsgBox "Pick Another Name and try again"
Exit Sub

Else
'copies activesht
ActiveSheet.Copy befo=Sheets(1)
ActiveSheet.Name = newname

With Sheets(oldsht) 'changes to values
.Range("j8:j45").Value = .Range("j8:j45").Value
.Shapes("Rectangle 1").Cut
End With

With ActiveSheet 'fix formula to reflect last month
chgto = Sheets(.Index + 1).Name
chgfrom = Sheets(.Index + 2).Name
.Range("L8:L45").Replace chgfrom, chgto

'does as of on cell a3
asn = ActiveSheet.Name
nd = DateSerial(Right(asn, 2), Left(asn, 2), Mid(asn, 3, 2))
..Range("a3") = "As of " & Format(nd, "mmmm dd, yyyy")
End With

With Sheets("MB Report") 'fixes mbreport
.Range("h11:h42").Value = .Range("D11:D42").Value
.Range("E11:E42").ClearContents
End With

Exit For
End If
Next s
Application.ScreenUpdating = True
End Sub


--
Don Guillett
Microsoft MVP Excel
SalesAid Software

"rcorona106" wrote in message
...
Here's the entire macro:
Sub Insert_New_Sheet()
Dim oldShtName As String
Dim newShtName As String
Dim wSht As Object
Dim wShtExists As Boolean
Dim inputPrompt As String

oldShtName = ActiveSheet.Name

inputPrompt = "Enter name for new sheet or Cancel to exit."

Do
wShtExists = False
Beep
newShtName = InputBox(prompt:=inputPrompt, _
Title:="New Sheet Name")

'Next few lines of code required in case user Cancels
'or user only enters only spaces in the input box.
'or user enters nothing and clicks on OK.
If Len(Trim(newShtName)) = 0 Then
Beep
MsgBox "Invalid entry or user Cancelled." _
& Chr(13) & Chr(13) & "New worksheet not created."
End
End If

For Each wSht In Sheets
If LCase(wSht.Name) = LCase(newShtName) Then
wShtExists = True
inputPrompt = _
"Worksheet name already exists. Enter new name"
End If
Next wSht
Loop While wShtExists = True

'Following line adds sheet as first sheet
Sheets.Add Befo=Sheets(1)

ActiveSheet.Name = newShtName
Sheets(oldShtName).Cells.Copy
Sheets(newShtName).Paste


' This goes to current month's sheet and hard codes the current month's
activity

Sheets(oldShtName).Select
Range("J8:J14").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("J18:J36").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("J40:J45").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False

' This will update YTD total and clear recently ended month's total on the
data sheet

Sheets("MB Report").Select
Range("D11:D42").Select
Selection.Copy
Range("H11").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("E11:E42").Select
Application.CutCopyMode = False
Selection.ClearContents

' This updates the YTD total on the new monthly sheet


Sheets(newShtName).Select

Range("L8:L48").Select
Selection.Replace What:="oldShtName", Replacement:="newShtName",
LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End Sub

Maybe with the entire programming, my problem will make sense.


"Don Guillett" wrote:

Don't know why you needed sheetname in the formula but here you go. No
selections and no looking. Fire from anywhere in the workbook.

Sub changesheetnameinformula()
Sheets("sheet2").Range("L8:L48").Replace "sheet1", "sheet2"
End Sub


--
Don Guillett
Microsoft MVP Excel
SalesAid Software

"rcorona106" wrote in message
...
Hey OssieMac,

Your help to Jorge has helped me a lot with something I'm working on.
If
you can, I'd love your help with one problem I'm having. Here's the
code
of
my macro:

Sheets(newShtName).Select
Range("L8:L48").Select
Selection.Replace What:="oldShtName", Replacement:="newShtName",
LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

What I'm trying to do is to go the new sheet and change the formula in
cells
L8 through L48 by replacing the old sheet's name with the new sheet's
name.
The above didn't work. How do I make it work? Thanks in advance for
your
help.

"OssieMac" wrote:

Hi Again Jorge,

This has become war and peace.

Protecting the new sheet.
Before you do anything with the following code, I advise making a
backup
of
your workbook in case of problems.

Your question about identifying and matching the locked and unlocked
cells
in the new sheet intrigued me enough to research it. Below is yet
another
version of code for you. You still have to insert your code into it
and I
have put a comment in uppercase where I think it should go.

You also have to edit the range A1:K40 to match the range that you are
using
on your spreadsheets. Dont try to use the entire spreadsheet range or
you
will be waiting until the New Year for the procedure to run. Simply
include a
range large enough to cover all the data on your sheet. Doesnt matter
if
it
is larger but cant be smaller.

I am assuming that you know that protecting the sheet is a 2 step
procedure.
Firstly step is to unlock cells that the user will be allowed to edit
and
second step is to protect the sheet using a password.

The code identifies the unlocked cells on the original sheet and
unlocks
the
corresponding cells on the new sheet. It then protects the new sheet
with
a
password and then re-protects the original sheet with the password.

My thoughts are that the old sheet should be totally protected to
prevent
users making retro changes to it. If you would like to be able to do
this, I
have included a line of code that you can uncomment to do it. However
read
and heed the comment in upper case because once you run it with this
line,
all cells on the original will be locked and you will not be able to
use
it
as a sample to create a new sheet with the specific unlocked cells.
You
will
need to manually unlock the editing cells again if you still need to
make
further adjustments to the code etc to get everything right. Note that
the
USER WITH THE PASSWORD will still be able to make changes to the old
sheet if
required and it doesnt matter whether the cells are locked or
unlocked
once
it is unprotected with the password.

I am going away for a week to ten days from Tuesday so if you need any
final
tweaking then I need to know about it by early Monday or it waits
until I
get
home again.

Sub Insert_New_Sheet()

Dim oldShtName As String
Dim newShtName As String
Dim wSht As Object
Dim cellAddress As String
Dim workRnge As Range
Dim c1 As Range

oldShtName = ActiveSheet.Name

'Create string variable from date in
'Active Sheet cell K3 + 14 days
newShtName = Format(ActiveSheet.Range("K3") _
+ 14, "d-mm-yyyy")

'Test that new sheet name not previously created.
For Each wSht In Sheets
If LCase(wSht.Name) = LCase(newShtName) Then
MsgBox "Worksheet " & newShtName & _
" already exists." & Chr(13) & _
"Processing terminated"
End
End If
Next wSht

'Unprotect so that button will copy
'Replace OssieMac with your password.
Sheets(oldShtName).Unprotect ("OssieMac")

'If cell K3 in the old sheet is to be updated
'with the + 14 days then take the single quote _
'off the following line. (See comment at end also.)

'Sheets(oldShtName).Range("K3") = ActiveSheet.Range("K3") + 14

'Following line adds sheet as first sheet
Sheets.Add Befo=Sheets(1)

'Following line adds sheet before active sheet
'Sheets.Add Befo=Sheets(oldShtName)

'Following line adds sheet after active sheet
'Sheets.Add After:=Sheets(oldShtName)

'Following line adds sheet after last sheet
'Sheets.Add After:=Sheets(Sheets.Count)

ActiveSheet.Name = newShtName
Sheets(oldShtName).Cells.Copy
Sheets(newShtName).Paste

Sheets(oldShtName).Range("B34").Copy
Sheets(newShtName).Select
Range("B21").Select
ActiveSheet.Paste Link:=True

Application.CutCopyMode = False

'If you updated the date in cell K3
'in the original sheet above with the +14
'then it will have been copied with the update
'to the new sheet. However, if you did not
'include it above but want it updated in the
'new sheet then remove the single quote from _
'the following line.

'Sheets(newShtName).Range("K3") = _
Sheets(newShtName).Range("K3") + 14

'INSERT YOUR CODE HERE.

'All the following code should be last code in
'procedure.
'Unlock cells on new sheet to match the unlocked
'cells in the original sheet. (ie. Cells that
'the user is allowed to edit.

'Edit code "A1:K40" in next line to match the
'working range on YOUR original sheet.
Set workRnge = Sheets(oldShtName).Range("A1:K40")
For Each c1 In workRnge
If c1.Locked = False Then
cellAddress = c1.Address
Sheets(newShtName).Range(cellAddress) _
.Locked = False
End If
Next c1

'Protect the new sheet
'Replace OssieMac with your password
Sheets(newShtName).Protect Password:="OssieMac", _
DrawingObjects:=True, _
Contents:=True, _
Scenarios:=True

'Reprotect the original sheet.
'Replace OssieMac with your password.

'Uncomment the following line of code if you
'want to prevent retro changes to the old
'sheet by anyone without the password.
'DO NOT UNCOMMENT THIS LINE UNTIL YOU HAVE
'TOTALLY FINISHED TESTING THE PROCEDURE AND
'EVEN THEN, MAKE SURE THAT YOU HAVE A BACKUP
'OF THE WORKBOOK.

'Sheets(oldShtName).Cells.Locked = True

Sheets(oldShtName).Protect Password:="OssieMac", _
DrawingObjects:=True, _
Contents:=True, _
Scenarios:=True

End Sub

Regards,

OssieMac


"OssieMac" wrote:

The only way that I know of copying the button is to unprotect the
sheet,
copy it and then protect it again. Another version of the code below
to
show
you how to do it.

With the code you posted for protecting all worksheets I think that
it
still
requires you to unlock the cells that users are allowed to alter
before
applying the protection. This will also apply to the newly created
worksheet
and your best way is to record the unlocking. You don't have to do
this
to
the original again just because you unprotect it because
unprotection
does
not remove the unlocked info.

Sub Insert_New_Sheet()
Dim oldShtName As String
Dim newShtName As String
Dim wSht As Object

oldShtName = ActiveSheet.Name

'Unprotect so that button will copy
'Replace OssieMac with your password.
Sheets(oldShtName).Unprotect ("OssieMac")

'Create string variable from date in
'Active Sheet cell K3 + 14 days
newShtName = Format(ActiveSheet.Range("K3") _
+ 14, "d-mm-yyyy")

'Test that new sheet name not previously created.
For Each wSht In Sheets
If LCase(wSht.Name) = LCase(newShtName) Then
MsgBox "Worksheet " & newShtName & _
" already exists." & Chr(13) & _
"Processing terminated"
End
End If
Next wSht

'If cell K3 in the old sheet is to be updated
'with the + 14 days then take the single quote _
'off the following line. (See comment at end also.)
'Sheets(oldShtName).Range("K3") = ActiveSheet.Range("K3") + 14

'Following line adds sheet as first sheet
Sheets.Add Befo=Sheets(1)

'Following line adds sheet before active sheet
'Sheets.Add Befo=Sheets(oldShtName)

'Following line adds sheet after active sheet
'Sheets.Add After:=Sheets(oldShtName)

'Following line adds sheet after last sheet
'Sheets.Add After:=Sheets(Sheets.Count)

ActiveSheet.Name = newShtName
Sheets(oldShtName).Cells.Copy
Sheets(newShtName).Paste

Sheets(oldShtName).Range("B34").Copy
Sheets(newShtName).Select
Range("B21").Select
ActiveSheet.Paste Link:=True

Application.CutCopyMode = False

'If you updated the date in cell K3
'in the original sheet above with the +14
'then it will have been copied with the update
'to the new sheet. However, if you did not
'include it above but want it updated in the
'new sheet then remove the single quote from _