Sub creerFeuilles()
Dim curCell As Range
Dim NomOnglet As String
Set curCell = ThisWorkbook.Sheets("Intro").Range("J2")
While curCell.Value <> vbNullString
ThisWorkbook.Sheets("Agent").Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
NomOnglet = curCell.Value & " " & curCell.Offset(0, 1).Value
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = NomOnglet
ThisWorkbook.Sheets(NomOnglet).Range("R5") = ThisWorkbook.Sheets("Intro").Range("K" & curCell.Row)
ThisWorkbook.Sheets(NomOnglet).Range("F5") = ThisWorkbook.Sheets("Intro").Range("L" & curCell.Row)
ThisWorkbook.Sheets("Intro").Hyperlinks.Add Anchor:=curCell.Offset(0, 3), Address:="", SubAddress:= _
"'" & ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name & "'!J2", TextToDisplay:="Acces Feuille"
Set curCell = curCell.Offset(1, 0)
Wend
ThisWorkbook.Sheets("Intro").Select
End Sub