Kopie Schreibgeschützt speichern
18.10.2022 07:27:31
Bernd_hat
mit dem unten stehenden Makro speichere ich zwei Blätter einer Datei als xlsx Datei ab.Ich benutze diese Dateien zur Auswertung .Die Hauptdatei ist mit einem Passwort geschützt.So dass nur dort eingetragen werden kann wo es gewünscht ist.
Nun kommt es vor das diese kopierten Dateien von Personen geöffnet und verändert werden.
Das möchte ich verhindern indem ich die kopierten Dateien komplett im Bereich C25:AB1089 un-beschreibbar mache und mit einem Passwort schütze.
Leider bin ich nicht in der Lage den Code so anzupassen das die Kopie geschützt wird.
Eventuell findet jemand die Zeit mir den Code so zu ändern.
Würde mich sehr freuen.
Sub copyData()
Application.EnableEvents = False
Userform.Show (0)
DoEvents
Eingaben.Unprotect Password:="1234"
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Worksheets(Array("tabelle1", "tabelle2")).Copy
Rows("1:3").Select
With Selection.Interior
.PatternColorIndex = xlAutomatic
.Color = 255
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("C25:AB1089").Value = Range("C25:AB1089").Value
Range("C25").Select
ActiveWorkbook.SaveAs Filename:="XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWorkbook.Close 0
Application.OnTime Now() + TimeValue("00:30:00"), "copyData"
Unload Userform
Application.CalculateFull
Eingaben.Protect Password:="1234"
Application.EnableEvents = True
End Sub