tabellenblatt aus datei auf desktop abspeichern

Question

Hallo Experten,
ich bin mir sicher, es gibt irgendwo im Netz eine Antwort auf meine (einfache) Frage, aber ich komme mir so hilflos vor...
Aus einer existierenden Datei möchte ich gerne - durch drücken eines Buttons - ein bestimmtes Tabellenblatt ("Kalkulation1") als separates Datenblatt auf dem Desktop als xls-file abspeichern. Der Name des Tabellenblattes soll zusammen mit dem aktuellen Datum der Name der neuen Datei sein.
Könnt Ihr mir hier weiterhelfen?
Im Voraus ein herzliches Dankeschön für Eure Hilfe.

Answer 1

Hi M.O.

auf dem Ur-Datenblatt ist ein Blattschutz - damit nicht jeder darin rumfingern kann.
Nach dem Abspeichern der umgewandelten Werte (keine Formeln/Verweise) soll dieser Blattschutz für das Ur-Datenblatt UND das neu abgespeicherte Dokument wieder aktiviert werden.
Neues Dokument soll unter "Kalkulation 1" auf dem Desktop (incl. Blattschutz) abgespeichert werden.

Viele Grüße
-matze-

Answer 2

Hallo Matze,

ich gehe mal davon aus, dass ein Passwort für den Blattschutz besteht:

Sub desktop_speichern()

Dim strPfad As String
Dim strPW As String
Dim Zelle As Range

'Variable für das Passwort - anpassen!!!
strPW = "Passwort"
'Pfad; Datei wird auf Desktop des in Windows angemeldeten Users abgelegt
strPfad = "C:\Users\" & Environ("Username") & "\Desktop\"

'Prüfen, ob Blattschutz vorhanden ist und falls ja, dann Blattschutz aufheben:
If ThisWorkbook.Worksheets("Kalkulation1").ProtectContents = True Then
'das Passwort anpassen (zwischen den Anführungszeichen nach Unprotect
ThisWorkbook.Worksheets("Kalkulation1").Unprotect strPW
End If

'Arbeitsblatt Kalkualtion1 in neue Mappe kopieren
ThisWorkbook.Worksheets("Kalkulation1").Copy
With ActiveWorkbook
'alle Zellen durchlaufen
For Each Zelle In .ActiveSheet.UsedRange
'falls Formel in Zelle steht, dann
If Zelle.HasFormula = True Then
'prüfen, ob in Formel Verweis auf externe Mappe steht
If InStr(Zelle.Formula, "[") > 0 Then
'falls ja, Wert in entsprechende Zelle schreiben
Zelle = Zelle.Value
End If
End If
Next Zelle
'kopierte Tabelle wieder mit Passwort schützen
.ActiveSheet.Protect strPW
'speichern
.SaveAs Filename:=strPfad & .ActiveSheet.Name & "_" & Date & ".xls"
End With
'die Quelltabelle wieder schützen
ThisWorkbook.Worksheets("Kalkulation1").Protect strPW

End Sub

Das Passwort musst du entsprechend anpassen.
Falls du das VBA-Projekt schützen willst, dann lies mal hier nach: KLICK!

Gruß

M.O.

Answer 3

es funktioniert...!!! :-)

Vielen Dank für die Hilfe --> M.O.