Excel VBA - Datei speichern unter - Pfad und Name aus Datei generieren

Hallo zusammen,

ich scheitere gerade an wahrscheinlich sehr einfachen Dingen.

Ziel sollte sein, dass eine Datei an einen bestimmten Ort abgespeichert werden soll. Der Pfad und Name wird per Formel in Excel ermittelt.
Bei allen Versuchen hatte ich keinen Erfolg - immer neue Fehler.

Die Excel Datei besteht aus 4 Registerkarten, wobei nur 2 abgespeichert werden müssen. ("Datenblatt" & "Tabelle1")

Der Pfad steht in Registerkarte "Pfade" Zelle "G2" und wird per Formel ermittelt.
Der Name soll sich zusammensetzen aus den Zellen "F2" & "E2" ebenfalls aus der Registerkarte "Pfade". "F2" und "E2" sind ebenfalls Formeln.

Verwenden wollte ich folgenden Code, aber diesen bekomme ich nicht angepasst:

Sub SpeichernUnter()
 Dim Neuer_Dateiname
 Dim i As Integer
 Dim WBS As Workbook
 Dim WS As Worksheet

 With Worksheets(Array("Datenblatt", "Tabelle1"))  
     .Copy
     Set WBS = ActiveWorkbook
     For Each WS In WBS.Worksheets
         WS.UsedRange.Value = WS.UsedRange.Value
     Next WS
 End With

 Application.CutCopyMode = False
 Neuer_Dateiname = Application.GetSaveAsFilename(InitialFileName:= ??? , fileFilter:="Excel Files (*.xlsx), *.xlsx")  
 If Neuer_Dateiname = False Then Exit Sub
 WBS.SaveAs Filename:=Neuer_Dateiname
 End Sub

Die Originaldatei ist schreibgeschützt und soll auch nicht verändert werden, daher wollte ich mit der Kopie von Registerkarten arbeiten.
Bei den Fragezeichen müssten doch jetzt meine Zellbezüge rein, aber das bekomme ich nicht hin.

Mein Problem ist bestimmt, dass ich kopieren und in ein neues Dokument schiebe...

Vielen Dank und viele Grüße

kaiuuwe28

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 354093

Url: https://administrator.de/contentid/354093

Ausgedruckt am: 16.11.2024 um 19:11 Uhr

3 Kommentare

Neuester Kommentar

Hey,

in einem älteren Projekt habe ich mir die Pfadangaben und Dateinamen in Variablen gezogen:

    
    Dim Zelle1 As String
    Dim Zelle2 As String
    
    Zelle1 = Sheets("Tabelle1").Cells(1, 1).Value 'Pfadangabe (String)  
    Zelle2 = Sheets("Tabelle1").Cells(1, 2).Value 'Dateiname (String)  

    Dateipfad = Zelle1 & Zelle2
    
    ActiveWorkbook.SaveCopyAs Dateipfad

Vielleicht kannst du das entsprechend einbauen/umbauen.
Vlg

Sub SaveSheets()
    Dim newWB As Workbook
    Application.DisplayAlerts = False
    Set newWB = Workbooks.Add
    While newWB.Sheets.Count > 1
        newWB.Sheets(1).Delete
    Wend
    With ThisWorkbook
        .Sheets("Datenblatt").Copy newWB.Sheets(1)  
        .Sheets("Tabelle1").Copy newWB.Sheets(1)  
        With .Sheets("Pfade")  
            newWB.Sheets(newWB.Sheets.Count).Delete
            newWB.SaveAs .Range("G2").Text & "\" & .Range("E2").Text & .Range("F2").Text & ".xlsx", xlOpenXMLWorkbook  
            newWB.Close
        End With
    End With
    Application.DisplayAlerts = True
    msgbox "Ey alder, fertsch!"  
End Sub