Sub creerFeuilles()
Dim curCell As Range
Set curCell = ThisWorkbook.Sheets("Liste").Range("A1")
While curCell.Value <> vbNullString
ThisWorkbook.Sheets.Add After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = curCell.Value & " " & curCell.Offset(0, 1).Value
ThisWorkbook.Sheets("0 Liste").Hyperlinks.Add Anchor:=curCell.Offset(0, 2), Address:="", SubAddress:= _
"'" & ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name & "'!A1", TextToDisplay:="Acc"
Set curCell = curCell.Offset(1, 0)
Wend
ThisWorkbook.Sheets("Liste").Select
End Sub