copy sheet and cell value based on list and rename as per list with excel vba code - excel

Question

i am very new to vba , currently i am looking for code to copy cell values from list to multiple sheet in specific cell
what i am trying to do is as per bellow sheet "point" i have a list with values column B are the names and C & D are values
i need to copy sheet named "template" and rename as per the values in Column B and the values are un defined and be upto any length
list sheet
template
currently i am using bellow code to copy sheet and rename as per list
Sub CopySheetRenameFromCell()
Dim sh1 As Worksheet, sh2 As Worksheet, c As Range
Set sh1 = Sheets("template")
Set sh2 = Sheets("point")
For Each c In sh2.Range("B6", sh2.Cells(Rows.Count, 2).End(xlUp))
sh1.Copy After:=Sheets(Sheets.Count)
On Error Resume Next
ActiveSheet.Name = c.Value:
On Error GoTo 0
Next
End Sub
result sheet
but i have no idea how can i copy value from "point" Sheet Column C and D values 1 & 51 to sheet "a" Column C2 and F2 and so on
a values in sheet "a"
b values in sheet "b" and on
awaiting your help

Answer 1

Copy Template Worksheet
This is a basic code. It assumes that each of the cells of the range B6:BLastRow contains a valid value for naming a worksheet. It also assumes that each of the worksheets to be created does not exist already.
Option Explicit
Sub CopySheetRenameFromCell()
' Reference the workbook ('wb').
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
' Reference the source worksheet ('sws').
Dim sws As Worksheet: Set sws = wb.Worksheets("Point")
' Calculate the source last row ('slRow'),
' the row of the last non-empty cell in the column.
Dim slRow As Long
slRow = sws.Cells(sws.Rows.Count, "B").End(xlUp).Row
' Reference the template worksheets ('tws').
Dim tws As Worksheet: Set tws = wb.Worksheets("Template")
' Declare additional variables.
Dim dws As Worksheet ' Current Destination (Copied) Worksheet
Dim sr As Long ' Current Row in the Source Worksheet
' Loop through the rows of the source worksheet.
For sr = 6 To slRow
' Create a copy of the template worksheet after the last sheet
' in the workbook.
tws.Copy After:=wb.Sheets(wb.Sheets.Count)
' Reference this copy, the destination worksheet,
' which is the last (work)sheet in the workbook.
Set dws = wb.Sheets(wb.Sheets.Count)
' Rename the destination worksheet.
dws.Name = sws.Cells(sr, "B").Value
' Write the values from columns 'C' and 'D' in the row ('r')
' of the source worksheet to the cells `C2` and `F2` respectively
' in the destination worksheet.
dws.Range("C2").Value = sws.Cells(sr, "C").Value
dws.Range("F2").Value = sws.Cells(sr, "D").Value
Next sr
' Save the workbook.
'wb.Save
' Inform.
MsgBox "Point worksheets created.", vbInformation
End Sub