VBA Code to create new template from workbook

[Sallyfomthevalley]

Hi there,

I am new to VBA and after endless hours of searching for my required code I have landed here in the hope someone can help me please..

I have created a time sheet within excel and I would like to add a command button to the workbook so that any user can simply click on the button and it will create a fresh time sheet. I did add a code, however this code created a new workbook and what I need is a new timesheet template.

Any help would be hugely appreciated as I am slowly turning into an insomniac and really need to finish this task.

I am using the latest version of excel.

The template range is D1:I66

Filename is TFL Timesheet ( xslm )

Many thanks in advance

Sally

 

[JPARKHURST]

If you don't mind the blind leading the blind. I setup a file with a time sheet in your specified range, and named the sheet containing the template 'Template". Here is the code I got to work, with a few notations:

I do not paste the range to d1...d66, as I was having some issues assigning the specific paste range - it can be worked on.

Page names could probably use an input box, it currently names the new page the date you create it or a version of.

The error checking on page names is weak, could use some love.

If anybody has other pointers or suggestions I'll be waiting to hear from them as you are.



Public Sub CreateTimesheet()
Dim wbTime As Workbook
Dim wsTemplate As Worksheet
Dim wsNew As Worksheet
Dim rgTemplate As Range
Dim dtDay As Date
Dim stName As String
Dim ver As Integer

ver = 1

'Workbook set to active workbook
Set wbTime = ActiveWorkbook
'Name of wsTemplate should be the worksheet which contains your template
Set wsTemplate = Sheets("Template")

'Create Sheet name from date
stName = Format(Date, "MMDD")
stName = Replace(stName, "/", "-")

'Create new worksheet
Set wsNew = Worksheets.Add(After:=Sheets(Worksheets.Count))

'Ensure sheet does not exists, check and add revision if so
If (WorksheetExists(stName)) Then
Do
stName = stName & "-" & ver
ver = ver + 1
Loop Until Not WorksheetExists(stName)
wsNew.Name = stName
Else
'Name worksheet according to above conditions.
wsNew.Name = stName
End If

'Activate Template
wsTemplate.Activate

'To Automatically set template up to used cells
Set rgTemplate = wsTemplate.UsedRange
'To Setup Template 'hard coded' to your values
'Set rgTemplate = wsTemplate.Range("D1:D66")
rgTemplate.Copy

'Past info to new template (does not preserve original placement in WS)
wsNew.Activate
ActiveSheet.Paste
wsTemplate.Activate


End Sub


'taken from etfa https://stackoverflow.com/questions/20075651/shorthand-for-x-x1
Function WorksheetExists(sName As String) As Boolean
WorksheetExists = Evaluate("ISREF('" & sName & "'!A1)")
End Function

 

[Sallyfomthevalley]

Hello fellow blind person haha.

Thank you so much for sharing your code! It is much appreciated.

Sally

 

[JPARKHURST]

I was looking over this the other day and I believe I found my error on pasting in the same range. If you see, I set the rgTemplate to the wsTemplate.UsedRange - this will incorporate all ranges from a1 on down - and (I believe) makes pasting it back into d2... not viable. Since you are working in a known environment, I think I would just comment that out (or remove it), and then use the rgTemplate = wsTemplate.Range("D1:D66"), you should then be able to paste into the correct range with a paste statement (activate cell d1 on new worksheet, then paste).

HTH,

Jon