vielleicht kann mir jemand helfen.
Ich möchte ein Arbeitsblatt beim Speichern immer mit einer fortlaufenden Nummer versehen und an einer ganz bestimmten Stelle speichern.
Vielen Dank highman4
Sub SaveIt()
Application.ScreenUpdating = False
Dim Pfad$, Title$, datei$, max&, name$, shl
Pfad = ThisWorkbook.Path & "\xlData " & Year(Now) 'oder anpassen
Title = "Rechnung" 'anpassen
If Dir(Pfad, vbDirectory) = "" Then
MkDir Pfad
End If
datei = Dir(Pfad & "\" & "*" & Title & ".xls")
Do Until datei = ""
If Val(Left(datei, 3)) > max Then
max = Val(Left(datei, 3))
End If
datei = Dir()
Loop
If max = 0 Then max = 1: GoTo NextS
mx = Format(max + 1, "000")
NextS:
name = mx & "_" & Title & ".xls"
ChDir Pfad
ActiveWorkbook.SaveCopyAs Filename:= _
Pfad & "\" & name
shl = Shell("Explorer.exe /n, /select," & Pfad & "\" & name, vbNormalFocus)
' oder MsgBox "Kopie wurde erfolgreich erstellt !"
End Sub