automatische Dateinummerierung
Björn
Hallo Mayk,
versuch's mal hiermit:
Sub Makro2()
'Funktioniert mit bis zu 99.999 Dateien
Dim strPath As String
Dim strName As String
Dim strFile As String
Dim Dateiname_ohne_Endung As String
Dim datei As String
Dim letzte_datei As String
Dim Version As Long
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
strPath = "C:\Daten\" 'Pfad bitte anpassen
Dateiname_ohne_Endung = "Hallo" 'Dateiname_ohne_Endung bitte anpassen
datei = Dir(strPath & "\" & Dateiname_ohne_Endung & "_?" & ".xls")
letzte_datei = datei
If datei <> "" Then
Versionsnummer = Left(Right(letzte_datei, 9), 5)
Else
Versionsnummer = 0
End If
While datei <> ""
datei = Dir
If Left(Right(datei, 9), 5) > Left(Right(letzte_datei, 9), 5) Then
letzte_datei = datei
Versionsnummer = Left(Right(datei, 9), 5)
End If
Wend
strName = Dateiname_ohne_Endung & "_" & Format(Versionsnummer, "00000")
strFile = strPath & strName & ".xls"
ActiveWorkbook.SaveAs Filename:=strFile
Range("B5:E16").Select
Selection.ClearContents
Range("E4").Select
Selection.ClearContents
End Sub
Denke bitte daran den Pfad und den Dateinamen ohne Endung an Deine Verhältnisse anzupassen.
Gruß
Björn