Copy Multiple Range on Multiple Sheets.

Excel VBA Help Please

I am trying to copy a template multiple times and name each sheets from a list.
So far, I have this part working.
From the same list, I have, next to the names, 3 colums with numbers in it called Rounds.
I also want the 3 round numbers to be part of the new sheets I copied for each name of the list.
The name range is I5:I16 and it is called Teams
The rounds range is J5:L16 and it is called Rounds
Each round must be copied on the new sheet in range P2:R2
The part in Bold in my code does not work.
See file attached


here is my VBA code but the round section in BOLD does not work

Code:

---

Sub CREATE_FICHE_PERSO()
'
' CREATE_SHEET_PERSO Macro
'This will create a file from a template called Sheet_Perso for every team from a range of 12 teams called Teams in worksheet PICK
'It will also name each worksheet with the name of each team
Dim ws As Worksheet
Dim Ct As Long
Dim c As Range
Set ws = Worksheets("sheet_perso")
For Each c In Sheets("PICK").Range("Teams")
    If c.Value <> "" Then
        ws.Visible = True
        ws.Copy before:=Sheets("sheet_perso")  'copy new Fiche perso
        ws.Visible = False
        ActiveSheet.Name = c.Value              'Name the new sheet
        Range("C2").Select
        ActiveCell = c.Value
        Sheets("PICK").Range("J5:L16").Copy
        ActiveSheet.Select
        Range("P2:R2").Select
        ActiveSheet.Paste
            Ct = Ct + 1
    End If
Next c
If Ct > 0 Then
MsgBox Ct & " new sheets created from list"
Else
MsgBox "no name on list"
End If
End Sub

---

Would it be that you have a typo or didn't select the correct range?

Code:

---

Sheets("Pick").Range("J5:L16").copy
Range("P2:R12").paste

---

try:

Code:

---

Sub CREATE_FICHE_PERSO2()
'
' CREATE_FICHE_PERSO Macro
'This will create a file from a template called Fiche_Perso for every team from a range of 12 teams called Teams in worksheet PICK
'It will also name each worksheet with the name of each team

Dim ws As Worksheet
Dim Ct As Long
Dim c As Range
Set ws = Worksheets("sheet_perso")
ws.Visible = True
For Each c In Sheets("PICK").Range("Teams")
  If c.Value <> "" Then
    ws.Copy before:=Sheets("sheet_perso")    'copy new Fiche perso
    With ActiveSheet
      .Name = c.Value    'Name the new sheet
      .Range("C2") = c.Value
      c.Offset(, 1).Resize(, 3).Copy .Range("P2")
    End With
    Ct = Ct + 1
  End If
Next c
ws.Visible = False
If Ct > 0 Then
  MsgBox Ct & " new sheets created from list"
Else
  MsgBox "no name on list"
End If
End Sub

---

Thanks to p45cal
Solved