Hallo zusammen,

ich bin Neuling im Umgang mit VBA. Komme im Großen und Ganzen aber gut zurecht. Nun kämpfe ich aber mit zwei Problemen, bei denen ich einfach nicht weiterkomme.

Ich möchte drei Datenblätter aus der aktiven Datei heraus in eine neue Datei kopieren und diese speichern. Dabei möchte ich, dass

• dass die Farbpalette der aktuellen Datei übernommen wird
• die Verknüpfung (1) von Diagrammen in die Ausgangsdatei aufgelöst werden
• nur Werte, nicht aber mehr Formeln zur Verfügung stehen
• die Blätter (ohne Passwort) geschützt werden
• die Datei per Speichern unter abgespeichert wird

Was NICHT funktioniert ist

• Die Verknüpfung der Diagramme wird nicht aufgelöst, es gibt auch keine Fehlermeldung
• Das Speichern funktioniert nicht (Laufzeitfehler 13, Typen unverträglich)

Unten findet ihr auch den bisherigen Code.

Kann mir da jemand helfen??

Gruß

Jan

Sub Export_XLS()
'Kopiert die Datenblätter "Filter", "Prämissen" und "Diagramme" in eine neue Datei
  Dim ws As Worksheet, Link As Variant, Datei As String, Titel As String
  
  'Abfragen, ob der Titel korrekt ist
  Titel = InputBox("Bitte überprüfen Sie vor dem Export den Titel der Analyse:", "Titel der Analyse", Tabelle13.Range("B9"))
  If Titel = "" Then Exit Sub
  Call DieseArbeitsmappe.Berechnen

  'Datenblätter in neues Workbook kopieren
  Sheets(Array("Filter", "Prämissen", "Diagramme")).Copy
  
  For Each ws In Workbooks(Workbooks.Count).Sheets
  'Blattschutz aufheben
    ws.Unprotect Password:="XXX"
  Next
  
  'Farben übernehmen
  Workbooks(Workbooks.Count).Colors = ThisWorkbook.Colors
  
  'Diagrammverknüpfungen aufheben
  Link = Workbooks(Workbooks.Count).LinkSources(Type:=xlLinkTypeExcelLinks)
  Workbooks(Workbooks.Count).BreakLink Name:=Link(1), Type:=xlLinkTypeExcelLinks
    
  For Each ws In Workbooks(Workbooks.Count).Sheets
    'VBA-Code entfernen
    With Workbooks(Workbooks.Count).VBProject.VBComponents(Workbooks(Workbooks.Count).Worksheets(ws.Name).CodeName).CodeModule
      .DeleteLines 1, .CountOfLines
    End With
    
    'Formeln durch Werte ersetzen
    ws.Unprotect Password:="Altersbaum"
    ws.Range("A1:IV65536").Copy
    ws.Range("A1:IV65536").PasteSpecial Paste:=xlValues
    
    'Zell- und Blattschutz setzen
    ws.Range("A1:IV65536").Locked = True
    ws.Protect UserInterfaceOnly:=True
    
    'Cursor setzen
    ws.Activate
    ws.Range("a1").Select
    Application.SendKeys ("^{POS1}")
  Next
    
  'Speichern und schließen
  Datei = Application.GetSaveAsFilename(fileFilter:="Microsoft Office Excel-Arbeitsmappe (*.xls), *.xls")
  If Datei <> False Then Workbooks(Workbooks.Count).SaveAs Filename:=Datei
End Sub