Sub TabellenAlsDateienSpeichern()
Dim strPfad As String
Dim wksBlatt As Worksheet
Dim wkbZiel As Workbook
Application.ScreenUpdating = False
Application.DisplayAlerts = False
strPfad = ThisWorkbook.Path & "\Tabellen\"
If Dir(strPfad, vbDirectory) = "" Then
MkDir strPfad
End If
For Each wksBlatt In ThisWorkbook.Worksheets
wksBlatt.Copy
Set wkbZiel = ActiveWorkbook
wkbZiel.SaveAs (strPfad & wksBlatt.Name)
wkbZiel.Close savechanges:=False
Next wksBlatt
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub