File in eigenem neuen Unterordner ablegen

Private Sub CommandButton5_Click()
Dim Vname As Variant
Dim IndName As Integer
Dim Verzeichnis As String
Dim UOrdner As String
Dim Dateiname As String
Verzeichnis = Range("L19")
Range("R8").Select
UOrdner = Range("R8")
Range("P16").Select
Dateiname = Range("P16")
If Dir(Verzeichnis, vbDirectory) <> "" Then
ActiveWorkbook.SaveAs Filename:=Dateiname, FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
Else
MsgBox "Bitte Verzeichnis " & Chr(13) & Verzeichnis & Chr(13) & _
" anlegen!" & Chr(13) & Chr(13), vbDirectory
On Error GoTo mkd_Err
mkd_Err:
If Err = 75 Then Resume Next
End If
End Sub