S
steveh
I have the following code that creates a new sheet when activated. I also would like it create a new column on a 'total' worksheet each time it is run, with myname from the code as the column header.
Public Sub CreateExtendedReservation()
Dim wkSht As Worksheet
Dim createSht As Worksheet
Dim myName As String
Application.ScreenUpdating = False
Set createSht = Worksheets("CREATE RESERVATION")
myName = createSht.Range("C5").Text
On Error Resume Next
Set wkSht = Worksheets(myName)
On Error GoTo 0
If wkSht Is Nothing Then
With Worksheets("EXTENDED RESERVATION")
.Visible = True
.Copy After:=Sheets(2)
.Visible = False
End With
With ActiveSheet
.Name = myName
With .Range("C1:C7")
.Value = createSht.Range("C2:C8").Value
.Locked = True
Range("c2").Select
End With
With .Range("B9:B104")
' .Formula = createSht.Range("B9:B104").Formula
.Locked = True
.FormulaHidden = False
End With
.Protect DrawingObjects:=True, _
Contents:=True, Scenarios:=True
End With
End If
Application.ScreenUpdating = True
Sheets("create reservation").Select
Range("c2:c8").Select
Selection.ClearContents
Range("c2").Select
'Sheets("createsht").Select
End Sub
Thanks in advance
Steve
Public Sub CreateExtendedReservation()
Dim wkSht As Worksheet
Dim createSht As Worksheet
Dim myName As String
Application.ScreenUpdating = False
Set createSht = Worksheets("CREATE RESERVATION")
myName = createSht.Range("C5").Text
On Error Resume Next
Set wkSht = Worksheets(myName)
On Error GoTo 0
If wkSht Is Nothing Then
With Worksheets("EXTENDED RESERVATION")
.Visible = True
.Copy After:=Sheets(2)
.Visible = False
End With
With ActiveSheet
.Name = myName
With .Range("C1:C7")
.Value = createSht.Range("C2:C8").Value
.Locked = True
Range("c2").Select
End With
With .Range("B9:B104")
' .Formula = createSht.Range("B9:B104").Formula
.Locked = True
.FormulaHidden = False
End With
.Protect DrawingObjects:=True, _
Contents:=True, Scenarios:=True
End With
End If
Application.ScreenUpdating = True
Sheets("create reservation").Select
Range("c2:c8").Select
Selection.ClearContents
Range("c2").Select
'Sheets("createsht").Select
End Sub
Thanks in advance
Steve