|  
                                             Hallo Matthias, 
falls ich es richtig verstanden habe, sollte es so reichen: 
Sub InAktuellenOrdnerNeueOrdner()
    Dim OrdnerNeu$, Pfad_VorlageDatei$, aktuellerPfad$, FileExt$
    
    Pfad_VorlageDatei = "C:\Users\Uwe\Documents\RS-G Vorlage.xlsm"  ' anpassen
    FileExt = Mid(Pfad_VorlageDatei, InStrRev(Pfad_VorlageDatei, ".", , vbTextCompare), 5)
    aktuellerPfad = ThisWorkbook.Path & "\"
    OrdnerNeu = InputBox("Bitte Namen für neuen Ordner eintragen", "Neuer Unterodner", "RSG 08-24")
    If Dir(aktuellerPfad & OrdnerNeu, vbDirectory) = "" Then
        MkDir aktuellerPfad & OrdnerNeu
    End If
    FileCopy Pfad_VorlageDatei, aktuellerPfad & OrdnerNeu & "\" & "Schüler" & OrdnerNeu & FileExt
End Sub
Gruß Uwe 
     |