Speichern mit VBA, wenn Datei vorhanden nichts machen

Hallo zusammen,

aktuell habe ich mir eine Datei erstellt und ein VBA so gut es funktioniert um eine zweite Datei zu öffnen.
* Dabei wird von der ersten Datei zwei Zellen kopiert und der Inhalt in eine Bestimmte Zelle in der Zweiten Datei eingefügt. Funktioniert.
* Ebenso wird die Zweite Datei unter dem Namen abgespeichert laut Vorgabe.

Mein Problem ist, wenn die Datei schon besteht mit dem Namen darf die Datei nicht überschrieben werden und gespeichert.

Also kurz und knapp, Wenn Dateinamen vorhanden nichts machen.
Bekomme es einfach nicht hin, alleine dieser Code den ich Anhänge habe ich schon eine Ewigkeit gebraucht :-) Profi halt hehehehehe.
Eventuell gibt es eine elegante Lösung dafür.

Sub ZweiteDateiOeffnenUndSpeichern()

    Dim quellPfad As String

    Dim zielName As String

    Dim quellMappe As Workbook

    Dim zielMappe As Workbook



    ' Pfad zur zweiten Datei anpassen

    quellPfad = "C:\Users\TimoW\Desktop\Test Datei Excel\Test Datei Excel Bericht.xlsx"



    ' Zelle anpassen, aus der der Name gelesen werden soll (z.B. A1)

    zielName = ThisWorkbook.Sheets("Drucken").Range("J3").Value



Range("J3").Select

    Application.CutCopyMode = False

    Selection.Copy



    ' Zweite Datei öffnen

    Set quellMappe = Workbooks.Open(quellPfad)

    

     Windows("Test Datei Excel Bericht.xlsx").Activate

    Range("C5").Select

    ActiveSheet.Paste

    



    Windows("Drucken Chargenblätter 27.08.2025-Linie 8 - 002192 - Rev. 12 - -.xlsm").Activate

Range("J5").Select

    Application.CutCopyMode = False

    Selection.Copy

    

        Windows("Test Datei Excel Bericht.xlsx").Activate

    Range("H5").Select

    ActiveSheet.Paste

    

    

    ' Sicherstellen, dass ein gültiger Name vorhanden ist

    If zielName = "" Then

        MsgBox "Bitte geben Sie einen gültigen Namen in Zelle J3 ein.", vbCritical

        quellMappe.Close SaveChanges:=False

        Exit Sub

    End If

    



    ' Aktive Arbeitsmappe speichern

    ' Speichern Sie die aktuelle Arbeitsmappe unter dem neuen Namen

    ' Achten Sie darauf, dass Sie den Speicherort selbst festlegen!

    ActiveWorkbook.SaveAs Filename:="C:\Users\TimoW\Desktop\Test Datei Excel\" & zielName & ".xlsx", FileFormat:=xlOpenXMLWorkbook



 

    ' Wenn Sie die Quelldatei nicht schließen wollen, können Sie diesen Befehl auskommentieren oder löschen

    quellMappe.Close SaveChanges:=False



End Sub

Gruß Timo

Hallo Onur,

danke schonmal für deine Unterstützung.

nach dem einfügen des Codes bekomme ich eine Fehlermeldung, Fehler beim Kompilieren: Syntaxfehler

folgendes ist rot Markiert : DatNam:="C:\Users\TimoW\Desktop\Test Datei Excel\" & zielName & ".xlsx"

Hänge mal den aktuellen code wie ich ihn jetzt stehen habe mit an.

Sub ZweiteDateiOeffnenUndSpeichern()

    Dim quellPfad As String

    Dim zielName As String

    Dim quellMappe As Workbook

    Dim zielMappe As Workbook

    Dim zielPfad As String

    Dim zielDateiName As String

    Dim existiert As Boolean

    Dim DatNam



    ' Pfad zur zweiten Datei anpassen

    quellPfad = "C:\Users\TimoW\Desktop\Test Datei Excel\Test Datei Excel Bericht.xlsx"



    ' Zelle anpassen, aus der der Name gelesen werden soll (z.B. A1)

    zielName = ThisWorkbook.Sheets("Drucken").Range("J3").Value



Range("J3").Select

    Application.CutCopyMode = False

    Selection.Copy



    ' Zweite Datei öffnen

    Set quellMappe = Workbooks.Open(quellPfad)

    

     Windows("Test Datei Excel Bericht.xlsx").Activate

    Range("C5").Select

    ActiveSheet.Paste

    



    Windows("test neu Drucken Chargenblätter 27.08.2025-Linie 8 - 002192 - Rev. 12 - -.xlsm").Activate

Range("J5").Select

    Application.CutCopyMode = False

    Selection.Copy

    

        Windows("Test Datei Excel Bericht.xlsx").Activate

    Range("H5").Select

    ActiveSheet.Paste

    

    

     Windows("test neu Drucken Chargenblätter 27.08.2025-Linie 8 - 002192 - Rev. 12 - -.xlsm").Activate

Range("O7").Select

    Application.CutCopyMode = False

    Selection.Copy

    

        Windows("Test Datei Excel Bericht.xlsx").Activate

    Range("j4").Select

    ActiveSheet.Paste

    

    

    ' Sicherstellen, dass ein gültiger Name vorhanden ist

    If zielName = "" Then

        MsgBox "Bitte geben Sie einen gültigen Namen in Zelle J3 ein.", vbCritical

        quellMappe.Close SaveChanges:=False

        Exit Sub

    End If

    

    

    

    zielPfad = "C:\Users\TimoW\Desktop\Test Datei Excel\"

    zielDateiName = Range("J3").Value ' Beispiel: Der Name kommt aus Zelle A1

    

    ' Prüfen, ob die Datei existiert

    existiert = Dir(zielPfad & zielDateiName & ".xlsx") > ""

    

    If existiert Then

        MsgBox "Die Datei '" & zielDateiName & ".xlsx' existiert bereits. Bitte wählen Sie einen anderen Namen."

    Else

    

    

    End If

    

  

    

' Aktive Arbeitsmappe speichern

    ' Speichern Sie die aktuelle Arbeitsmappe unter dem neuen Namen

    ' Achten Sie darauf, dass Sie den Speicherort selbst festlegen!

    DatNam:="C:\Users\TimoW\Desktop\Test Datei Excel\" & zielName & ".xlsx"

    On Error GoTo ExistiertNicht

    Workbooks.Open Filename:=DatNam

    Workbooks(DatNam).Close

    Exit Sub

    

ExistiertNicht:

    ActiveWorkbook.SaveAs Filename:=DatNam ', FileFormat:=xlOpenXMLWorkbook

End Sub

eventuell habe ich beim einfügen und kopieren einen Fehler eingebaut.

Muss jetzt erstmal ins Bett, hatte Nachtschicht.

schönen Tag, bis Später.
Gruß Timo

Speichern mit VBA, wenn Datei vorhanden nichts machen

Forumthread: Speichern mit VBA, wenn Datei vorhanden nichts machen

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Speichern mit VBA, wenn Datei vorhanden nichts machen

Forumthread: Speichern mit VBA, wenn Datei vorhanden nichts machen

10 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread