Macro to create new worksheet from template and copy certain fields from that worksheet into a summary worksheet

[Minilin]

Hiya,

I am creating a Risk Register and would like to be able to click a button that then creates a new worksheet based on a template, that is named "Risk" followed by a number ideally "Risk 1.0". The next one would then be called"Risk 2.0" and so on and so on.

At the same time I would like certain fields from the template to be copied into a Summary worksheet at the front. This information won't be a range of data but in random fields (if you get what I'm trying to say).

So far I have managed to get it to copy a template worksheet I set up, which then names itself "Risk1", "Risk2" etc

I cannot work out how to do the second part.

Here is what I have already, taken from another site I'd like to add. My experience with this sort of thing is minimal.

Private Sub CommandButton1_Click()
 
 Dim lngLoop As Long
 Dim wsTest As Excel.Worksheet
 Dim wsSource As Excel.Worksheet
 
 Dim strNewName As String
 
 Const ROOTName As String = "Risk"
 Const SourceSheet As String = "Template"
 Const MaxTries As Long = 1000
 
 '// Set a reference to the source sheet. If it does not exist then
 '// the standard debug window will be displayed
 Set wsSource = Sheets(SourceSheet)
 
 '// The code may raise errors - ignore, these are handled directly
 '// by the code
 On Error Resume Next
 
 '// Loop a max number of times. I've never seen
 '// a workbook with 150 worksheets, never mind 1000
 '// as defined here.. Change the CONST declaration to
 '// something a littl emore suitable for your needs
 For lngLoop = 1 To MaxTries
 
 '// Derive the new worksheet name
 strNewName = ROOTName & CStr(lngLoop)
 
 '// See if it exists already...
 Set wsTest = Sheets(strNewName)
 
 '// If wsTest is nothing then sheet Riskx does not exist
 If wsTest Is Nothing Then
 
 '// Exit the loop. Finished here
 Exit For
 Else
 '// It does exist. Clear the reference to the worksheet
 Set wsTest = Nothing
 '// Clear the error
 Err.Clear
 End If
 
 '// If it gets to here then it loops again
 Next
 
 '// Last check - there's less than (1000) worksheets?
If lngLoop < MaxTries Then
 
 '// Copy the source sheet and place at end of sheets tab.
 wsSource.Copy After:=Worksheets(Worksheets.Count)
 
 '// Rename the new sheet. Only a general ACTIVESHEET reference
 '// as this will be the active sheet after the copy
 With ActiveSheet
 .Name = strNewName
 .Range("B3").Value = "Risk" & CStr(lngLoop)
 '// OR
 '// .Range("B3").Value = strNewName
 End With
Else
 
 '// Tell user the sheet was not copied.
 MsgBox "Are you really going to work with " & CStr(MaxTries) & " worksheets...?", vbExclamation, "Don't be silly"
End If
End Sub

 

[Minilin]

Have given up on this, got code partially working then decided not wroth effort.