Option Explicit
Sub Protokoll_speichern()
Dim neuerName As String, Speicherpfad As String, letzterOrdner As String
letzterOrdner = Range("D3")
Speicherpfad = "C:\irgendeinelendslangerdateipfad\" & letzterOrdner & "\"
If Dir(Speicherpfad, vbDirectory) = "" Then
MkDir Speicherpfad
End If
neuerName = "dieser Teil kappt schon"
ActiveWorkbook.SaveAs Filename:=Speicherpfad & neuerName
End Sub