Sub
SeperateWorksheets2XLSX()
Dim
wks
As
Worksheet
Dim
wkbNew
As
Workbook
On
Error
GoTo
FinishErr
Application.ScreenUpdating =
False
Application.DisplayAlerts =
False
For
Each
wks
In
ThisWorkbook.Worksheets
Set
wkbNew = Workbooks.Add
wks.Copy After:=wkbNew.Worksheets(wkbNew.Worksheets.Count)
wkbNew.Worksheets(1).Delete
wkbNew.Close SaveChanges:=
True
, Filename:=wks.Range(
"U28"
).Text
Next
wks
FinishErr:
If
Err.Number <> 0
Then
MsgBox Err.Number & Err.Description, vbCritical,
"Autor informiert"
End
If
Application.DisplayAlerts =
True
Application.ScreenUpdating =
True
Set
wks =
Nothing
:
Set
wkbNew =
Nothing
End
Sub