Mit Hilfe von Herbers Excel Forum hat man mir dort 2018 einen öffentlich einsehbaren Code geschickt, Nutzername: Schwipp, der jeder Datei, die es mit demselben Namen schon gibt, eine Klammen mit sich darin erhöhender fortlaufender Nummer ergänzt. Dann hant man auch sehr schön eine zeitliche Abfolge.
Hier das ganze Makro, es läuft, mittleren Teil ansehen,
entscheidend ist die DO-Loop in der Mitte, die ich bekam!!!
Sub Abspeichern_neuer_Name() ’ mit Nr in Klammer wenn Nameschn vorhanden
Dim Wert As Integer
Dim strN As String
Dim strP As String
Dim lngZ As Long
Wert = Range(„a2“)
If Wert < 1 Then
GoTo Beenden 'Makro Abspeichern_neuer_Name - wie in Betreff - nicht ausführen,wenn noch kein Rechnungsblatt
End If 'mit makro Druckrechnung1 angelegt wurde
'und also die DateiNr in Zelle A2 noch nicht geschrieben ist,
'Zelle A2 wird beim erstmaligen Speichern
'eines neu geschriebenen Angebots beschrieben im Programm Rechnung 3
Dim dName$
Dim DatName As String
'alt : in Zelle A6 gespeicherter neuer DateiName wird in Variable DatName geschrieben:
'neu: in Zellen Betreff / unsere Zeichen F20 gespeicherter neuer DateiName wird in Variable DatName geschrieben:
DatName = ActiveWorkbook.Worksheets(1).Range(„F20“) 'bestimmt aktuell zu benutzenden Namen aus Zelle F20
strN = ActiveWorkbook.Worksheets(1).Range(„F20“) 'in F20 steht Malte oder Lola… oder…
strP = ThisWorkbook.Path & „\Rechnungen“ 'der Pfad also solcher zeigt auf die Masterdatei = Rechnung 3
lngZ = 1
Do
If Dir(strP & strN & "(" & lngZ & ").xls") = "" Then
Exit Do
Else
lngZ = lngZ + 1
End If
Loop
ActiveSheet.Copy
ActiveWorkbook.SaveAs strP & strN & „(“ & lngZ & „).xls“
ActiveWorkbook.Close Savechanges:=False 'False = speichert nicht auf Datenträger
Range(„A6“).Value = Range(„F20“) & „.“ 'fügt Punkt an in Zelle A6
ActiveWorkbook.Save
Application.Quit 'schließt Datei komplett
'dName = ThisWorkbook.Path & "\Rechnungen\" & Range("F20") & ".xls" 'alt
'abgeleitet aus: dName = ThisWorkbook.Path & "\RECHNUNGEN\" & TB.Range("k19") & "=Ang-Nr" & "_" & Range("A4") & ".xls" ' noch älter
’ ActiveSheet.Copy 'auch nach oben ??
’ ActiveWorkbook.SaveAs dName 'auch nach oben ???
’ ActiveWorkbook.Close Savechanges:=False 'auch nach oben ??
Beenden:
End Sub