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
|