Keep formating from old sheet in the new sheet

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

I have a macro which copies time sheets from the old/current sheet to a new
sheet.

I haave found that headers and other formating aspects of the sheet such as
row width and the page scaling is not maitained in the new sheet.

Is there a simple way of achieving this without resorting to using excels
macro recording facility?

Regards
Jorge
 
It sounds like you're creating a new sheet, then copying the data from the other
sheet.

How about copying the original sheet.

Record a macro when you do:
edit|Move or copy sheet (check copy)

and you'll see the code.
 
Hi Dave,

I was originally copying the entire sheet but it was slowish process, so I
then only copied the cell I needed. That's when I found that headers and
formating were not copying to the new sheet. Hence my request for assistance.

Regards
Jorge
 
I just checked my previous macro that copied and moved the "old" sheet, but I
found that it wasn't carrying over the header and footer nor the page setup
properties such as layout.

Regards
Jorge
 
Copy|pastespecial|formats
Copy|pastespecial|columnwidths (xl2k and higher)

And you'll have to copy the headers/footers, too:

With newworksheethere.PageSetup
.LeftHeader = oldworksheethere.pagesetup.leftheader
.CenterHeader = oldworksheethere.pagesetup.centerheader
'and so on...
End with

You may find copying the worksheet is easier.
 
Thanks Dave,

But I'm quite unfamilar with VBA; I've had a fair bit of assistance from
OssieMac.

I was unable to incorporate your code so below I have included what I have
so far in the hope you will be able to help.

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 ("1")

'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 Before:=Sheets(1)

'Following line adds sheet before active sheet
Sheets.Add Before:=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("B33").Copy
Sheets(newShtName).Select
Range("B20").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

'Delete old data from new sheet
Range("K3").Select
Selection.Copy
Range("J39").Select
ActiveSheet.Paste
Range("B5:K8").Select
Selection.ClearContents
Range("B10:K13").Select
Selection.ClearContents
Range("B15:K19").Select
Selection.ClearContents
Range("F31").Select
Selection.ClearContents
Range("K1").Select
Selection.ClearContents

'Copy|pastespecial|formats
'Copy|pastespecial|columnwidths (xl2k and higher)

'And you'll have to copy the headers/footers, too:

With ActiveSheet.Name.pagesetup
.LeftHeader = oldShtName.pagesetup.LeftHeader
.CenterHeader = oldShtName.pagesetup.CenterHeader
'and so on...
End With


'Freezing Panes at B5
Range("B5").Select
ActiveWindow.FreezePanes = True


'Reprotect all works sheets
For Each ws In ActiveWorkbook.Worksheets

If ws.ProtectContents = False Then
ws.Protect ("1")

End If

Next

Application.ScreenUpdating = True

End Sub
 
I find that using:

dim newSheetName as string
then
worksheets(newsheetname).name = ....
worksheets(newsheetname).range("a99").value = ....
clumsy to work with.

Instead of using a string variable to hold the name of the worksheet, you can
use a worksheet variable to hold a reference to that worksheet.

Dim NewSheet as worksheet
then
newsheet.name = ....
newsheet.range("a99").value = ....
easier to use and easier to understand.

This compiled and ran for me. I _think_ it does what you want, but you'll have
to test it to make sure.

Option Explicit
Sub Insert_New_Sheet()

Dim OldSheet As Worksheet
Dim NewSheet As Worksheet
Dim NewSheetName As String
Dim wSht As Worksheet

Set OldSheet = ActiveSheet

OldSheet.Unprotect Password:="1"

NewSheetName = Format(OldSheet.Range("K3").Value + 14, "d-mm-yyyy")

Set wSht = Nothing
On Error Resume Next
Set wSht = Worksheets(NewSheetName)
On Error GoTo 0

If wSht Is Nothing Then
'worksheet doesn't exist, keep going
Else
MsgBox "Worksheet " & NewSheetName & _
" already exists." & vbLf & _
"Processing terminated"
Exit Sub
End If

'Following line adds sheet before active sheet
Set NewSheet = Sheets.Add(Before:=OldSheet)

NewSheet.Name = NewSheetName

OldSheet.Cells.Copy _
destination:=NewSheet.Range("A1")

'same as pasting the link
NewSheet.Range("b20").Formula _
= "=" & OldSheet.Range("b33").Address(external:=True)

With NewSheet
.Range("K3").Value = .Range("K3").Value + 14

.Range("K3").Copy _
Destination:=.Range("j39")

.Range("B5:K8, b10:k13,b15:k19,f31,k1").ClearContents

End With

With NewSheet.PageSetup
.LeftHeader = OldSheet.PageSetup.LeftHeader
.CenterHeader = OldSheet.PageSetup.CenterHeader
'and so on...
End With

'Freezing Panes at B5
With NewSheet
.Select 'required for .freezepanes
.Range("a1").Select
.Range("B5").Select
ActiveWindow.FreezePanes = True
End With

'Reprotect all works sheets
For Each wSht In ActiveWorkbook.Worksheets
If wSht.ProtectContents = False Then
wSht.Protect Password:="1"
End If
Next wSht

Application.ScreenUpdating = True

End Sub


JorgeG.ACT said:
Thanks Dave,

But I'm quite unfamilar with VBA; I've had a fair bit of assistance from
OssieMac.

I was unable to incorporate your code so below I have included what I have
so far in the hope you will be able to help.

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 ("1")

'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 Before:=Sheets(1)

'Following line adds sheet before active sheet
Sheets.Add Before:=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("B33").Copy
Sheets(newShtName).Select
Range("B20").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

'Delete old data from new sheet
Range("K3").Select
Selection.Copy
Range("J39").Select
ActiveSheet.Paste
Range("B5:K8").Select
Selection.ClearContents
Range("B10:K13").Select
Selection.ClearContents
Range("B15:K19").Select
Selection.ClearContents
Range("F31").Select
Selection.ClearContents
Range("K1").Select
Selection.ClearContents

'Copy|pastespecial|formats
'Copy|pastespecial|columnwidths (xl2k and higher)

'And you'll have to copy the headers/footers, too:

With ActiveSheet.Name.pagesetup
.LeftHeader = oldShtName.pagesetup.LeftHeader
.CenterHeader = oldShtName.pagesetup.CenterHeader
'and so on...
End With

'Freezing Panes at B5
Range("B5").Select
ActiveWindow.FreezePanes = True


'Reprotect all works sheets
For Each ws In ActiveWorkbook.Worksheets

If ws.ProtectContents = False Then
ws.Protect ("1")

End If

Next

Application.ScreenUpdating = True

End Sub
Click to expand...
 
Then your old macro wasn't copying the sheet--or something else was changing the
headers/footers.
 
Hi again Jorge,

I have re-entered the discussion on this. Dave had a good suggestion in one
of his previous posts on this thread about copying the sheet instead of
adding a sheet and then copying the data and he is quite right because this
works better in that it copies everything about the sheet including print
setups, freeze panes etc. I also assume that you have some cells in the
worksheet which are not protected otherwise the users would not be able to
enter any data and the copy sheet looks after this also. Therefore I have
added yet another version for you by modifying Dave's code.

I have gained something from your info Dave so thanks for that.

Sub Insert_New_Sheet()

'Adapted from Dave Petersen's replies to Jorge.ACT 19 June 2007
Dim OldSheet As Worksheet
Dim NewSheet As Worksheet
Dim NewSheetName As String
Dim wSht As Worksheet
Dim errorResult
Set OldSheet = ActiveSheet

OldSheet.Unprotect Password:="1"

NewSheetName = Format(OldSheet.Range("K3").Value + 14, "d-mm-yyyy")

Set wSht = Nothing
On Error Resume Next
Set wSht = Worksheets(NewSheetName)
On Error GoTo 0

If wSht Is Nothing Then
'worksheet doesn't exist, keep going
Else
MsgBox "Worksheet " & NewSheetName & _
" already exists." & vbLf & _
"Processing terminated"
Exit Sub
End If

'Adds sheet before active sheet and renames
OldSheet.Copy Before:=OldSheet
Set NewSheet = ActiveSheet
NewSheet.Name = NewSheetName

'same as pasting the link
NewSheet.Range("B20").Formula _
= "=" & OldSheet.Range("B33").Address(external:=True)

With NewSheet
.Range("K3").Value = .Range("K3").Value + 14

.Range("K3").Copy _
Destination:=.Range("J39")

.Range("B5:K8, B10:K13,B15:K19,F31,K1").ClearContents

End With

For Each wSht In ActiveWorkbook.Worksheets
If wSht.ProtectContents = False Then
wSht.Protect Password:="1"
End If
Next wSht

Application.ScreenUpdating = True

End Sub

Regards,

OssieMac
 
I haven't had time to see the difference but you have really sped things up.

Thanks to you both I have learnt heaps

Jorge
 
Thanks Dave,

Learnt heaps.

Jorge

Dave Peterson said:
I find that using:

dim newSheetName as string
then
worksheets(newsheetname).name = ....
worksheets(newsheetname).range("a99").value = ....
clumsy to work with.

Instead of using a string variable to hold the name of the worksheet, you can
use a worksheet variable to hold a reference to that worksheet.

Dim NewSheet as worksheet
then
newsheet.name = ....
newsheet.range("a99").value = ....
easier to use and easier to understand.

This compiled and ran for me. I _think_ it does what you want, but you'll have
to test it to make sure.

Option Explicit
Sub Insert_New_Sheet()

Dim OldSheet As Worksheet
Dim NewSheet As Worksheet
Dim NewSheetName As String
Dim wSht As Worksheet

Set OldSheet = ActiveSheet

OldSheet.Unprotect Password:="1"

NewSheetName = Format(OldSheet.Range("K3").Value + 14, "d-mm-yyyy")

Set wSht = Nothing
On Error Resume Next
Set wSht = Worksheets(NewSheetName)
On Error GoTo 0

If wSht Is Nothing Then
'worksheet doesn't exist, keep going
Else
MsgBox "Worksheet " & NewSheetName & _
" already exists." & vbLf & _
"Processing terminated"
Exit Sub
End If

'Following line adds sheet before active sheet
Set NewSheet = Sheets.Add(Before:=OldSheet)

NewSheet.Name = NewSheetName

OldSheet.Cells.Copy _
destination:=NewSheet.Range("A1")

'same as pasting the link
NewSheet.Range("b20").Formula _
= "=" & OldSheet.Range("b33").Address(external:=True)

With NewSheet
.Range("K3").Value = .Range("K3").Value + 14

.Range("K3").Copy _
Destination:=.Range("j39")

.Range("B5:K8, b10:k13,b15:k19,f31,k1").ClearContents

End With

With NewSheet.PageSetup
.LeftHeader = OldSheet.PageSetup.LeftHeader
.CenterHeader = OldSheet.PageSetup.CenterHeader
'and so on...
End With

'Freezing Panes at B5
With NewSheet
.Select 'required for .freezepanes
.Range("a1").Select
.Range("B5").Select
ActiveWindow.FreezePanes = True
End With

'Reprotect all works sheets
For Each wSht In ActiveWorkbook.Worksheets
If wSht.ProtectContents = False Then
wSht.Protect Password:="1"
End If
Next wSht

Application.ScreenUpdating = True

End Sub
Click to expand...
 
I recorded a macro and here is what I got

Sub Macro5()
'
' Macro5 Macro
'

'
Sheets("Current Loan Analysis").Select
ActiveSheet.Unprotect
Sheets("Current Loan Analysis").Select
ActiveSheet.Buttons.Add(1082.25, 34.5, 125.25, 80.25).Select
Sheets("Current Loan Analysis").Copy After:=Sheets(2)
Sheets("Current Loan Analysis (2)").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
Sheets("Current Loan Analysis").Select
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
False
Range("J1").Select
End Sub

The problem is - Sheets("Current Loan Analysis").Copy After:=Sheets(2)

next time there will be more sheets. I just want it added to the end. Also
I want to include the macro button that runs this macro. Will this work?
 
Back
Top