Dateinamen automatisch um fortlaufende Nummer Lola(1), Lola(2) ergänzen

[Schwipp]

Liebe Leute,
aus einer Masterdatei erzeuge ich Dateien mit den Namen Malte, Lola usw.
Manchmal ist es aber so, dass ich einen Fehler gemacht habe, und dass ich
die bereits gespeicherte Datei nicht überschreiben möchte,  

sondern den Dateinamen VOR .xls um ein zusätzliches Zeichen verlängern möchte, also Lola.xls, Lola..xls, Lola...xls
.
Wie muss ich den folgenden Code, der nicht von mir stammt,  ändern,  
damit das klappt?
Sub Abspeichern_neuer_Name()
Dim dName$
Dim DatName As String
 
DatName = ActiveWorkbook.Worksheets(1).Range("F20") ' in F20 steht Malte oder Lola... oder...
dName = ThisWorkbook.Path & "\Versuche\" & Range("F20") & ".xls
 
ActiveSheet.Copy
ActiveWorkbook.SaveAs dName
ActiveWorkbook.Close Savechanges:=False 
 
ActiveWorkbook.Save                      
Application.Quit                                                                      ' schließt Datei komplett
End Sub

Vielen Dank für Hilfe!
Ciao Schwipp

Nachtrag:

[Kuwer]

Hallo,

Sub Abspeichern_neuer_Name()
  Dim strN As String
  Dim strP As String
  Dim strZ As String
  
  strN = ActiveWorkbook.Worksheets(1).Range("F20") ' in F20 steht Malte oder Lola... oder...
  strP = ThisWorkbook.Path & "\Versuche\" '& Range("F20") & ".xls"
  strZ = "."
  
  Do
    If Dir(strP & strN & strZ & "xls") = "" Then
      Exit Do
    Else
      strZ = strZ & strZ
    End If
  Loop
  
  ActiveSheet.Copy
  ActiveWorkbook.SaveAs strP & strN & strZ & "xls"
  ActiveWorkbook.Close Savechanges:=False
   
  ActiveWorkbook.Save
  Application.Quit                              ' schließt Datei komplett
End Sub

Gruß Uwe

[Schwipp]

Uwe, herzlichen Dank, ich will das gleich mal testen!

[Kuwer]

Hallo,

mein vorheriger Code war Mist. Hier jetzt richtig und eine weitere Variante entsprechend Deinem Betreff mit Zähler in Klammern:

Option Explicit

Sub Abspeichern_neuer_Name_Punkte()
 Dim strN As String
 Dim strP As String
 Dim strZ As String
 
 strN = ActiveWorkbook.Worksheets(1).Range("F20") ' in F20 steht Malte oder Lola... oder...
 strP = ThisWorkbook.Path & "\Versuche\"
 strZ = "."
 
 Do
   If Dir(strP & strN & strZ & "xls") = "" Then
     Exit Do
   Else
     strZ = String(Len(strZ) + 1, strZ)
   End If
 Loop
 
 ActiveSheet.Copy
 ActiveWorkbook.SaveAs strP & strN & strZ & "xls"
 ActiveWorkbook.Close Savechanges:=False
  
 ActiveWorkbook.Save
 Application.Quit                              ' schließt Datei komplett
End Sub

Sub Abspeichern_neuer_Name_Zaehler()
 Dim strN As String
 Dim strP As String
 Dim lngZ As Long
 
 strN = ActiveWorkbook.Worksheets(1).Range("F20") ' in F20 steht Malte oder Lola... oder...
 strP = ThisWorkbook.Path & "\Versuche\"
 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
  
 ActiveWorkbook.Save
 Application.Quit                              ' schließt Datei komplett
End Sub

Code eingefügt mit: Excel Code Jeanie

Gruß Uwe

[Schwipp]

Hallo Uwe,
Im Archiv bei "Herber" habe ich sowas ähnliches gefunden, die Kombination Deines Codes mit dem des Archivs war aber noch nicht erfolgreich...
Hinsichtlich der Abfragen und der Messagebox-Anzeigen funktioniert das dem Archiv ,
und lautet für mich angepasst:

Sub TestText()
Dim TB As Worksheet
Dim dName$
Set TB = ActiveWorkbook.Worksheets(5) ' was bedeutet die 5?
dName = "F:\Versuche\ " & Range("F20") & ".xls"
If Dir$(dName, vbNormal) <> "" Then
MsgBox "'Datei ist vorhanden; "
Else
MsgBox "'Datei ist nicht vorhanden"
End If
End Sub

Vielen herzlichen Dank für Deine Mühe,
ciao Schwipp


Also ich probier jetzt erstmal Deine elegante Variante mit Zähler in Klammern!!! (reimt sich ja sogar!)

[Schwipp]

Uwe, genial, Klammerversion klappt perfekt auf Anhieb, 1000 Dank !