Sub Speichern()
Dim sFile As String, sOld As String
sOld = ThisWorkbook.Name
If IsNumeric(Mid(sOld, 9, 4)) Then
sOld = Mid(sOld, 9, 4)
Else
sOld = 0
End If
sOld = Format(CInt(sOld) + 1, "0000")
sFile = Range("A1").Text & "_"
sFile = sFile & Range("B1").Text & "_"
sFile = sFile & sOld & ".xls"
ThisWorkbook.SaveAs Range("E1").Value & _
"\" & sFile
End Sub
Recht, aber ich in dem Forum auch nicht so Sattelfest.
Sub Speichern()
Dim sFile As String, sOld As String
sOld = ThisWorkbook.Name ' Name der Mappe mit Code
If IsNumeric(Mid(sOld, 9, 4)) Then ' Püfen ob die Zeichen ab 9 Stelle 4 Stück _
numerisch sind
sOld = Mid(sOld, 9, 4)
Else
sOld = 0 ' die Zeihen sind nicht numerisch als 0
End If
' den ausgelesenen Wert oder die 0 Plus 1 mit 4 Ziffern anzeigen nicht benötigte Stellen mit _
0
sOld = Format(CInt(sOld) + 1, "0000")
' Inahlt aus Zelle A1 auslesen und ein Unterstrich anhängen
sFile = Range("A1").Text & "_"
' an die Varaible Sfile( Inhalt A1+_) den Inhalt von B1 und Unterstrich anhängen
sFile = sFile & Range("B1").Text & "_"
' Dateinamen aus den bisherigen Variablen Zusammenbauen
sFile = sFile & sOld & ".xls"
' Die Arbeitsmappe mit dem Code unter dem neuen Namen speichern der Ordner steht in E1
ThisWorkbook.SaveAs Range("E1").Value & "\" & sFile
End Sub