Jo4x4
I have made a few smakll changes to your macro and also changes my previous macro
The changes in your macro extract the old and new sheet names and then calls the new macro to copy the settings
Replace your existing code with this
The 3 changes are commented
[pre]
Code:
Sub Saveandreturn_Click()
Dim sh As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With Me
OldSht = Me.Name 'This is the existing sheet name
On Error Resume Next
.Parent.Worksheets(.Range("D4").Value).Delete
On Error GoTo 0
Set sh = .Parent.Worksheets.Add(After:=.Parent.Worksheets(.Parent.Worksheets.Count))
sh.Name = .Range("D4").Value
.Cells.Copy sh.Range("A1")
sh.UsedRange.Value = sh.UsedRange.Value
NewSht = .Range("D4").Value 'This is the New sheet name
Call Copy_Print_Settings(OldSht, NewSht) 'Call subroutine to copy print settings
End With
Me.Activate
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
[/pre]
and Copy the following to a code module
Sub Copy_Print_Settings(OldSht, NewSht)
Dim MyWrkBook As String
Worksheets(NewSht).Select
With ActiveSheet.PageSetup
.PrintArea = Worksheets(OldSht).PageSetup.PrintArea
.LeftHeader = Worksheets(OldSht).PageSetup.LeftHeader
.CenterHeader = Worksheets(OldSht).PageSetup.CenterHeader
.RightHeader = Worksheets(OldSht).PageSetup.RightHeader
.LeftFooter = Worksheets(OldSht).PageSetup.LeftFooter
.CenterFooter = Worksheets(OldSht).PageSetup.CenterFooter
.RightFooter = Worksheets(OldSht).PageSetup.RightFooter
.LeftMargin = Worksheets(OldSht).PageSetup.LeftMargin
.RightMargin = Worksheets(OldSht).PageSetup.RightMargin
.TopMargin = Worksheets(OldSht).PageSetup.TopMargin
.BottomMargin = Worksheets(OldSht).PageSetup.BottomMargin
.HeaderMargin = Worksheets(OldSht).PageSetup.HeaderMargin
.FooterMargin = Worksheets(OldSht).PageSetup.FooterMargin
.PrintHeadings = Worksheets(OldSht).PageSetup.PrintHeadings
.PrintGridlines = Worksheets(OldSht).PageSetup.PrintGridlines
.PrintComments = Worksheets(OldSht).PageSetup.PrintComments
.PrintQuality = Worksheets(OldSht).PageSetup.PrintQuality
.CenterHorizontally = Worksheets(OldSht).PageSetup.CenterHorizontally
.CenterVertically = Worksheets(OldSht).PageSetup.CenterVertically
.Orientation = Worksheets(OldSht).PageSetup.Orientation
.Draft = Worksheets(OldSht).PageSetup.Draft
.PaperSize = Worksheets(OldSht).PageSetup.PaperSize
.FirstPageNumber = Worksheets(OldSht).PageSetup.FirstPageNumber
.Order = Worksheets(OldSht).PageSetup.Order
.BlackAndWhite = Worksheets(OldSht).PageSetup.BlackAndWhite
.Zoom = Worksheets(OldSht).PageSetup.Zoom
.FitToPagesWide = Worksheets(OldSht).PageSetup.FitToPagesWide
.FitToPagesTall = Worksheets(OldSht).PageSetup.FitToPagesTall
.PrintErrors = Worksheets(OldSht).PageSetup.PrintErrors
.OddAndEvenPagesHeaderFooter = Worksheets(OldSht).PageSetup.OddAndEvenPagesHeaderFooter
.DifferentFirstPageHeaderFooter = Worksheets(OldSht).PageSetup.DifferentFirstPageHeaderFooter
.ScaleWithDocHeaderFooter = Worksheets(OldSht).PageSetup.ScaleWithDocHeaderFooter
.AlignMarginsHeaderFooter = Worksheets(OldSht).PageSetup.AlignMarginsHeaderFooter
.EvenPage.LeftHeader.Text = Worksheets(OldSht).PageSetup.EvenPage.LeftHeader.Text
.EvenPage.CenterHeader.Text = Worksheets(OldSht).PageSetup.EvenPage.CenterHeader.Text
.EvenPage.RightHeader.Text = Worksheets(OldSht).PageSetup.EvenPage.RightHeader.Text
.EvenPage.LeftFooter.Text = Worksheets(OldSht).PageSetup.EvenPage.LeftFooter.Text
.EvenPage.CenterFooter.Text = Worksheets(OldSht).PageSetup.EvenPage.CenterFooter.Text
.EvenPage.RightFooter.Text = Worksheets(OldSht).PageSetup.EvenPage.RightFooter.Text
.FirstPage.LeftHeader.Text = Worksheets(OldSht).PageSetup.FirstPage.LeftHeader.Text
.FirstPage.CenterHeader.Text = Worksheets(OldSht).PageSetup.FirstPage.CenterHeader.Text
.FirstPage.RightHeader.Text = Worksheets(OldSht).PageSetup.FirstPage.RightHeader.Text
.FirstPage.LeftFooter.Text = Worksheets(OldSht).PageSetup.FirstPage.LeftFooter.Text
.FirstPage.CenterFooter.Text = Worksheets(OldSht).PageSetup.FirstPage.CenterFooter.Text
.FirstPage.RightFooter.Text = Worksheets(OldSht).PageSetup.FirstPage.RightFooter.Text
End With
End Sub
Works well for me in Excel 2007.