Save row heights with VB copy

[stewart]

I have a scheduling sheet that gets copied at the end of each week and
pasted into a new sheet. (code below). The problem is that I have
several hidden rows that become visible when the sheet is pasted. How
do I copy the original exactly.

Private Sub btnFinal_Click()
Application.ScreenUpdating = False
ActiveSheet.Unprotect
'Finalize Schedule
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "Week " & Sheets("New Schedule").Range("a2")

Sheets("New Schedule").Select
Cells.Select
Selection.Copy

Dim Shname As String
With Sheets("New Schedule")
Shname = "Week " & Sheets("New Schedule").Range("a2")
End With
On Error Resume Next
Sheets(Shname).Select
On Error GoTo 0




ActiveSheet.Paste
Application.CutCopyMode = False
Range("a:s").Select
ActiveWindow.Zoom

Sheets("New Schedule").Select
Range("Week").Select
Selection.ClearContents
Range("a:s").Select
ActiveWindow.Zoom = True
Range("a2").Select
Range("a2") = Range("a2") + 1
Range("b3") = Range("b3") + 7
ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True
Application.ScreenUpdating = True

End Sub

 

[carlo]

I have a scheduling sheet that gets copied at the end of each week and
pasted into a new sheet. (code below). The problem is that I have
several hidden rows that become visible when the sheet is pasted. How
do I copy the original exactly.

Private Sub btnFinal_Click()
Application.ScreenUpdating = False
ActiveSheet.Unprotect
'Finalize Schedule
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "Week " & Sheets("New Schedule").Range("a2")

Sheets("New Schedule").Select
Cells.Select
Selection.Copy

Dim Shname As String
With Sheets("New Schedule")
Shname = "Week " & Sheets("New Schedule").Range("a2")
End With
On Error Resume Next
Sheets(Shname).Select
On Error GoTo 0

ActiveSheet.Paste
Application.CutCopyMode = False
Range("a:s").Select
ActiveWindow.Zoom

Sheets("New Schedule").Select
Range("Week").Select
Selection.ClearContents
Range("a:s").Select
ActiveWindow.Zoom = True
Range("a2").Select
Range("a2") = Range("a2") + 1
Range("b3") = Range("b3") + 7
ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True
Application.ScreenUpdating = True

End Sub

Hi stewart

the problem is, that you are not copying a worksheet...you are adding
a new worksheet and copying the content of the old one into the new
one..

Try this, should work better:

Private Sub btnFinal_Click()
Application.ScreenUpdating = False
ActiveSheet.Unprotect

Dim ws As Worksheet

Worksheets("New Schedule").Copy After:=Sheets(Sheets.Count)
Set ws = Worksheets(Sheets.Count)
ws.Name = "Week " & Sheets("New Schedule").Range("a2")
ws.Select

ws.Range("Week").ClearContents
ws.Range("a2") = ws.Range("a2") + 1
ws.Range("b3") = ws.Range("b3") + 7

ws.Range("a:s").Select
ActiveWindow.Zoom = True

ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True

Application.ScreenUpdating = True

End Sub

hth carlo