Workbook med mange ark, hvor hvert ark skal gennem som seperate filer med macro

Rem Kode indsættes i VBA / ThisWorkbook
Public Sub gemArkSomFil()
Const stiNavn = "C:\Users\peter\Desktop\"            'justeres
Dim ark As Worksheet
    For Each ark In ActiveWorkbook.Sheets
        With ark
            filnavn = .Name
            .Select
            .Copy
            ChDir stiNavn
            ActiveWorkbook.SaveAs Filename:=stiNavn & filnavn & ".xlsx", _
                FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
               
            ActiveWorkbook.Close
        End With
    Next ark
End Sub