Arcticwarrio
Active Member
- Joined
- Dec 6, 2005
- Messages
- 439
Hello all,
i'd like to insert a vba script into a new worksheet with the Worksheet_NewSheet function
i currently have this
just incase your wondering, this copies the headers from the sheet named CURRENT resizes the columns, centers the text, turns the auto filter on, turns on freeze panes at cell E3 and renames the sheet to the first 3 letters of the month and the 2 digit year
i would also like to insert code code onto the sheet, is this possible as i cant find the function for it.
not that it matters but this is the script i want to insert onto all new sheets
cheers
Arctic.
i'd like to insert a vba script into a new worksheet with the Worksheet_NewSheet function
i currently have this
Code:
Private Sub Workbook_NewSheet(ByVal Sh As Object)
Dim SHNAME As String
SHNAME = UCase(Format(Date, "mmm yy"))
Sheets("CURRENT").rows("1:1").Copy Destination:=Sh.Range("A1")
With Sh
With .Range("A2:AZ2")
Sheets("CURRENT").rows("2:2").Copy Destination:=Sh.Range("A2")
.ColumnWidth = Array(9, 9, 9, 36, 48, 14, 17, 12, 7, 9, 11, 12, 8, 8, 20, 14, 14, 13, 10, 10, 11, 11, 14, 9, 13, 10, 10, 10, 10, 10, 17, 11, 13, 13, 12, 9, 12, 12, 12, 12, 12, 12, 13, 16, 13, 16, 13, 16, 13, 11, 15, 15)
.EntireColumn.HorizontalAlignment = xlCenter
.Font.Size = 8
.Font.Bold = True
.AutoFilter
End With
.Range("E3").Select
ActiveWindow.FreezePanes = True
.name = SHNAME
End With
End Subjust incase your wondering, this copies the headers from the sheet named CURRENT resizes the columns, centers the text, turns the auto filter on, turns on freeze panes at cell E3 and renames the sheet to the first 3 letters of the month and the 2 digit year
i would also like to insert code code onto the sheet, is this possible as i cant find the function for it.
not that it matters but this is the script i want to insert onto all new sheets
Code:
' ZVI:2011-04-26 ver2 http://www.mrexcel.com/forum/showthread.php?t=462316
' Copy text contents of the Rng range to the clipboard.
' Reference to Microsoft Forms 2.0 is not required.
Sub RangeToClipboard()
Dim s As String
s = Selection.Value
With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") ' <-- Late binding for DataObject
.GetFromClipboard
's = .GetText
.Clear
.SetText s
.PutInClipboard
End With
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Column = 1 Then
If Target.Cells.Count <> 1 Then Exit Sub
RangeToClipboard
Application.CutCopyMode = False
Cancel = True
Selection.Offset(0, 7).Select
Selection.Interior.ColorIndex = xlNone
End If
End Subcheers
Arctic.
