Celle tekst til ark navn automatisk ?

Sub NyeArk()
    On Error GoTo fejl
    For Each c In Selection.Cells
        sname = c.Value
        If Not IsEmpty(c) Then
            Sheets.Add
            ActiveSheet.Move after:=Sheets(Sheets.Count)
            ActiveSheet.Name = c.Value
        End If
    Next c
    Exit Sub

fejl:

    If Err.Number = 1004 Then
        MsgBox "Mindst et af de ark, du prøver at oprette eksisterer allerede" & vbCrLf & _
        "Ret fejlen og prøv igen", vbOKOnly + vbCritical
        Application.DisplayAlerts = False
        ActiveSheet.Delete
        Application.DisplayAlerts = True
    End If
End Sub