Gem flere ark i samme fil til individuelle filer

Option Explicit

Sub SaveSheets()
Dim wb As Workbook, NewWb As Workbook, ws As Worksheet
Set wb = ThisWorkbook
For Each ws In wb.Worksheets
    Set NewWb = Application.Workbooks.Add
    Application.DisplayAlerts = False
    With NewWb
        ws.Copy after:=NewWb.Sheets(1)
        .Sheets(1).Delete
        .SaveAs (ws.Name) ' filen får navnet på arket, du kan evt skrive stien foran altså ("C:\dinsti\" & ws.name)
        .Close
    End With
    Application.DisplayAlerts = False
Next
End Sub