Hallo an Alle,
per Button werden 2 Tabellenblätter kopiert und nur die Werte in eine neue Datei gespeichert.
Dies klappt auch wunderbar!
Doch wenn ich die Blätter schütze bekomme ich immer eine Fehlermeldung.
Beende ich diese Fehlermeldung 1004, werden die Blätter trotzdem weiterhin wie gewünscht kopiert.
Nun meine Frage, wie stelle ich es an damit überhaupt keine Fehlermeldung erscheint?
Die fett und kursiv dargestellten Zeilen werden als Fehler aufgezeigt.
Hoffe ihr könnt mir helfen.
Grüsse
Pet
Option Explicit
Sub BlätterKopierenOhneFormeln()
Dim Blätter, B As Byte, Dateiname As String, PfadDatei As String
Dim Eingabe
Blätter = Array("VL_St_Ber", "VL_Std_Uebers")
Eingabe = InputBox("Dateiname", "Dateiauswahl", "MeineDatei")
If Eingabe = "" Then Exit Sub
On Error GoTo Fehler
Workbooks.Open Eingabe & ".xls"
On Error GoTo 0
With ActiveWorkbook
For B = 0 To UBound(Blätter)
ThisWorkbook.Worksheets(Blätter(B)).Copy After:=.Worksheets(.Worksheets.Count)
Next B
Application.DisplayAlerts = False
For B = 1 To .Worksheets.Count - 2
.Worksheets(1).Delete
Next B
With .Worksheets("VL_St_Ber")
.Name = "St_Ber_" & Format([L1], "mmm-yy")
.Cells.Copy
.Cells.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
End With
Application.CutCopyMode = False
With .Worksheets("VL_Std_Uebers")
.Name = "Std_Uebers_" & Format([L1], "mmm-yy")
.Cells.Copy
.Cells.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
End With
Application.CutCopyMode = False
Application.MaxChange = 0.001
.PrecisionAsDisplayed = False
.Date1904 = True
Application.DisplayAlerts = True
End With
Exit Sub
Fehler:
Workbooks.Add
ActiveWorkbook.SaveAs Eingabe & ".xls"
Resume Next
End Sub