VBA alle Blätter speichern funktioniert nicht rich

Sub AllSheetSpeichern()
Dim WS As Worksheet
Dim Path As String
Dim Wb As String
Dim lngFileformat As Long
Path = ActiveWorkbook.Path & "\einzeln\"
lngFileformat = ActiveWorkbook.FileFormat
lngFileformat = 51 'Blätter-Dateien ohne Makros im 2007/2010 Format speichern
If Dir(Left(Path, Len(Path) - 1), vbDirectory) = "" Then
VBA.MkDir Path:=Left(Path, Len(Path) - 1)
End If
Wb = ActiveWorkbook.Name
Wb = Left(Wb, InStrRev(Wb, ".") - 1)
For Each WS In ThisWorkbook.Worksheets
WS.Copy
ActiveWorkbook.SaveAs Filename:= _
Path & WS.Name & "-" & Wb, FileFormat:=lngFileformat
ActiveWorkbook.Close
Next
End Sub