A VBA code to create sheets based on a list

[seragrefaat]

I want to create and rename number of sheets based on values in range of cells, also after that i want to distribute each value of another list in a fixed cell, B39, of each sheet created.
I have already done the first part but i want someone to modify it to not fixed list (or range), i make the code with the range Q4:Q11, how to make the module executable when the rnge changes to Q4:Q7 or Q4:Q20? Thanks
/

Option Explicit
Sub CreateAndName6s()
    Dim c As Range
    Application.ScreenUpdating = False
    Sheets("Data").Select
    For Each c In Range("Q4:Q11")
        c.Select
        Sheets.Add After:=Sheets(Sheets.Count)
        Sheets(Sheets.Count).Name = c.Value
        Sheets("Template").Cells.Copy
        ActiveSheet.Paste
        Range("A1").Select
        Application.CutCopyMode = False
        Range("E4").Select
        ActiveSheet.Range("E4").Value = c.Value
        Sheets("Data").Select
        ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:=c.Value & "!A1", TextToDisplay:=c.Value

    Next c
    Application.ScreenUpdating = True
End Sub

 

[Fluff]

How about

Sub CreateAndName6s()
   Dim Cl As Range
   
   Application.ScreenUpdating = False
   With Sheets("Data")
      For Each Cl In .Range("Q4", .Range("Q" & Rows.Count).End(xlUp))
         Sheets("Template").Copy , Sheets(Sheets.Count)
         ActiveSheet.Name = Cl.Value
         ActiveSheet.Range("E4").Value = Cl.Value
         .Hyperlinks.Add Cl, "", Cl.Value & "!A1", Cl.Value
      Next Cl
   End With
   Application.ScreenUpdating = True
End Sub

Where are the values that need to go in B39?

 

[seragrefaat]

How about

Sub CreateAndName6s()
   Dim Cl As Range
  
   Application.ScreenUpdating = False
   With Sheets("Data")
      For Each Cl In .Range("Q4", .Range("Q" & Rows.Count).End(xlUp))
         Sheets("Template").Copy , Sheets(Sheets.Count)
         ActiveSheet.Name = Cl.Value
         ActiveSheet.Range("E4").Value = Cl.Value
         .Hyperlinks.Add Cl, "", Cl.Value & "!A1", Cl.Value
      Next Cl
   End With
   Application.ScreenUpdating = True
End Sub

Where are the values that need to go in B39?

Value is adjacent to the range Q4:Q11, R4 will bevin the first sheet, R5 in the second, etc.

 

[Fluff]

Ok, how about

Sub seragrefaat()
   Dim Cl As Range
   
   Application.ScreenUpdating = False
   With Sheets("Data")
      For Each Cl In .Range("Q4", .Range("Q" & Rows.Count).End(xlUp))
         Sheets("Template").Copy , Sheets(Sheets.Count)
         ActiveSheet.Name = Cl.Value
         ActiveSheet.Range("E4").Value = Cl.Value
         ActiveSheet.Range("B39").Value = Cl.Offset(, 1).Value
         .Hyperlinks.Add Cl, "", Cl.Value & "!A1", Cl.Value
      Next Cl
   End With
   Application.ScreenUpdating = True
End Sub

 

[seragrefaat]

Ok, how about

Sub seragrefaat()
   Dim Cl As Range
  
   Application.ScreenUpdating = False
   With Sheets("Data")
      For Each Cl In .Range("Q4", .Range("Q" & Rows.Count).End(xlUp))
         Sheets("Template").Copy , Sheets(Sheets.Count)
         ActiveSheet.Name = Cl.Value
         ActiveSheet.Range("E4").Value = Cl.Value
         ActiveSheet.Range("B39").Value = Cl.Offset(, 1).Value
         .Hyperlinks.Add Cl, "", Cl.Value & "!A1", Cl.Value
      Next Cl
   End With
   Application.ScreenUpdating = True
End Sub

Thanks alot, I will try your code tomorrow, and give you my feedback. ?

 

[Fluff]

Ok,

 

[seragrefaat]

Ok, how about

Sub seragrefaat()
   Dim Cl As Range
  
   Application.ScreenUpdating = False
   With Sheets("Data")
      For Each Cl In .Range("Q4", .Range("Q" & Rows.Count).End(xlUp))
         Sheets("Template").Copy , Sheets(Sheets.Count)
         ActiveSheet.Name = Cl.Value
         ActiveSheet.Range("E4").Value = Cl.Value
         ActiveSheet.Range("B39").Value = Cl.Offset(, 1).Value
         .Hyperlinks.Add Cl, "", Cl.Value & "!A1", Cl.Value
      Next Cl
   End With
   Application.ScreenUpdating = True
End Sub

There is an issue in the code, see screenshots plz, Everything is ok except it stops and when i press debug, i gives me an extra sheet (Template (2))

Thanks

 

[Fluff]

What is the value of Cl.Value when you get the error?

 

[seragrefaat]

What is the value of Cl.Value when you get the error?

Please see image 3_ names of sheets are there.

 

[Fluff]

That does not tell me what the value was when it failed. What is in the cell below 6-8