Sub creerFeuilles()
Dim curCell As Range
Set curCell = ThisWorkbook.Sheets("Intro").Range("J2")
While curCell.Value <> vbNullString
ThisWorkbook.Sheets.Add After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Cou nt)
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Nam e = curCell.Value & " " & curCell.Offset(0, 1).Value
ThisWorkbook.Sheets("Intro").Hyperlinks.Add Anchor:=curCell.Offset(0, 2), Address:="", SubAddress:= _
"'" & ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Nam e & "'!J2", TextToDisplay:="Acces Feuille"
Set curCell = curCell.Offset(1, 0)
Wend
ThisWorkbook.Sheets("Intro").Select
End Sub