ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Discussion (Misc queries) (https://www.excelbanter.com/excel-discussion-misc-queries/)
-   -   Save row heights with VB copy (https://www.excelbanter.com/excel-discussion-misc-queries/165232-save-row-heights-vbulletin-copy.html)

stewart

Save row heights with VB copy
 
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

Save row heights with VB copy
 
On Nov 8, 10:49 am, stewart wrote:
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



All times are GMT +1. The time now is 12:00 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com