View Single Post
  #6   Report Post  
Posted to microsoft.public.excel.programming
Dave Peterson Dave Peterson is offline
external usenet poster
 
Posts: 35,218
Default Keep formating from old sheet in the new sheet

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(Befo=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 wrote:

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

"Dave Peterson" wrote:

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.

JorgeG.ACT wrote:

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

"Dave Peterson" wrote:

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.



JorgeG.ACT wrote:

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

--

Dave Peterson


--

Dave Peterson


--

Dave Peterson