Code wird bei geschützter Mappe falsch ausgeführt

[briansen93]

Hallo Zusammen,

ich habe folgendes Problem:

Ich habe in Excel 2010 eine Datei mit einigen VBA-Codes geschrieben, wenn ich die nun auf meinem PC mit Excel 2016 ablaufen lassen will, führt er den Code nur richtig aus wenn ich davor die Mappe vom Schreibschutz "löse". auf Excel 2010 macht Excel die Ausführung der Codes jedoch einwandfrei? hat jemand ähnliche Problem und vielleicht eine Lösung parat?

Hier der Code:

Sub Maßnahmen_1()
'
' Maßnahmen1 Makro
'
'
    Application.ScreenUpdating = False
    Sheets("Maßnahmen").Unprotect
    Sheets("Themenboard").Unprotect
    Application.ScreenUpdating = False
    Dim a
    Dim b
    Dim c
    If Range("D4") <> 0 Then
   
    If Range("N4") = 0 Then
    Range("C4:F4").Select
    Selection.Copy
    Sheets("Maßnahmen").Visible = True
    Sheets("Maßnahmen").Select
    a = ActiveSheet.Cells(Rows.Count, 4).End(xlUp).Row + 1
    If Range("D6") = "" Then a = 6
    Range("C" & a).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    c = ActiveSheet.Cells(Rows.Count, 4).End(xlUp).Row + 0
    If Range("D6") = "" Then c = 6
    Range("B" & c).Select
    ActiveCell.FormulaR1C1 = "=1+R[-1]C"
    Range("B" & c).Select
    Selection.Copy
    Sheets("Themenboard").Select
    Range("N4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("M4").Select
    Selection.Copy
    Sheets("Maßnahmen").Select
    b = ActiveSheet.Cells(Rows.Count, 4).End(xlUp).Row
    If Range("G6") = "" Then a = 6
    Range("G" & b).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Sheets("Themenboard").Select
    Range("A1").Select
    Sheets("Maßnahmen").Visible = False
    Application.ScreenUpdating = True
   
    MsgBox ("Prozessstörung wurde in die Maßnahmenliste übertragen")
    Else
    MsgBox ("Prozessstörung schon in Maßnahmenliste übertragen")
    End If
    Else
    MsgBox ("Keine Prozessstörung vorhanden")
    End If
   
    Sheets("Themenboard").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    Sheets("Maßnahmen").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True
    Application.ScreenUpdating = True
   
   
   
End Sub

[Gast 123]

Hallo

ich kann nicht sagen woran es liegen kann, habe aber den Recorder Code mal ein bisschen umgeschrieben.
Auf Select kann man meistens verzichten, zur Vorsicht aber prüfen ob das kopieren ıns unsichtbare Blatt klappt!

mfg  Gast 123

Code:

Sub Maßnahmen_1()
Dim MAN As Worksheet, TMB As Worksheet
Set MAN = Sheets("Maßnahmen")
Set TMB = Sheets("Themenboard")

   Application.ScreenUpdating = False
   Sheets("Maßnahmen").Unprotect
   Sheets("Themenboard").Unprotect
   Application.ScreenUpdating = False
   Dim a As Long, b As Long, c As Long
   
   If Range("D4") <> 0 Then
   If Range("N4") = 0 Then
      a = MAN.Cells(Rows.Count, 4).End(xlUp).Row + 1
      If MAN.Range("D6") = "" Then a = 6
     
      TMB.Range("C4:F4").Copy
      MAN.Range("C" & a).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
      SkipBlanks:=False, Transpose:=False
      Application.CutCopyMode = False
   
      c = MAN.Cells(Rows.Count, 4).End(xlUp).Row + 0
      If MAN.Range("D6") = "" Then c = 6
     
      MAN.Range("B" & c).FormulaR1C1 = "=1+R[-1]C"
   
      MAN.Range("B" & c).Copy
      TMB.Range("N4").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
      SkipBlanks:=False, Transpose:=False
      Application.CutCopyMode = False
   
      b = MAN.Cells(Rows.Count, 4).End(xlUp).Row
      If MAN.Range("G6") = "" Then a = 6
     
      TMB.Range("M4").Copy
      MAN.Range("G" & b).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
      SkipBlanks:=False, Transpose:=False
      Application.CutCopyMode = False
   
     Sheets("Themenboard").Select
     Range("A1").Select
     Application.ScreenUpdating = True
   
   MsgBox ("Prozessstörung wurde in die Maßnahmenliste übertragen")
   Else
   MsgBox ("Prozessstörung schon in Maßnahmenliste übertragen")
   End If
   Else
   MsgBox ("Keine Prozessstörung vorhanden")
   End If
   
   Sheets("Themenboard").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
   Sheets("Maßnahmen").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True
   Application.ScreenUpdating = True
End Sub