Als Antwort auf diesen Beitrag
Hallo zusammen,
dank eurer Hilfe hatte ich in Excel 2021 die Programmierung im VBA hinbekommen. Jetzt wurde bei uns auf "Office LTSC Professional Plus 2024" umgestellt und es funktionieren alles bis auf eines. Die ActiveX-Elemente sind in den Einstellungen wieder aktiviert worden.
Der letzte Absatz, das Kopieren von "Plan" nach "Sicherung", funktioniert. Irgendwo beim Abgleich zwischen "Plan" und "Sicherung" und dem Schreiben der Änderungen in "Änderungen" liegt der Fehler. Das übersteigt aber leider meine Fähigkeiten hier den Fehler zu finden. Könnt ihr mir da bitte helfen?
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim ArrS, ArrP
Dim z As Long, s As Long
Dim X
Dim i As Long
Dim user As String
Application.ScreenUpdating = False
user = Environ("Username")
ArrS = Sheets("Sicherung").Range("A1:AF76").Value
ArrP = Sheets("Plan").Range("A1:AF76").Value
ReDim X(1 To UBound(ArrP, 1) * UBound(ArrP, 2), 1 To 6)
i = 0
For z = 2 To UBound(ArrS, 1)
For s = 2 To UBound(ArrS, 2)
If ArrS(z, s) <> ArrP(z, s) And ArrS(z, s) <> "VA" And ArrP(z, s) <> "VA" Then
i = i + 1
X(i, 1) = Date
X(i, 2) = ArrS(2, s)
If ArrP(z, 1) = "" Then X(i, 3) = ArrS(z, 1) Else X(i, 3) = ArrP(z, 1)
If ArrS(z, s) = "" Then X(i, 4) = "---" Else X(i, 4) = ArrS(z, s)
If ArrP(z, s) = "" Then X(i, 5) = "---" Else X(i, 5) = ArrP(z, s)
If IsError(Application.VLookup(user, Sheets("Berechnungen").Range("AL2:AM54"), 2, False)) Then X(i, 6) = Environ("Username") Else X(i, 6) = Application.WorksheetFunction.VLookup(user, Sheets("Berechnungen").Range("AL2:AM54"), 2, False)
End If
Next
Next
Worksheets("Änderungen").Unprotect
Sheets("Änderungen").Cells(Sheets("Änderungen").Cells(Rows.Count, 1).End(xlUp).Row + 1, 7).Locked = False
Sheets("Änderungen").Cells(Sheets("Änderungen").Cells(Rows.Count, 1).End(xlUp).Row + 1, 8).Locked = False
Sheets("Änderungen").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(UBound(X, 1), UBound(X, 2)) = X
Worksheets("Änderungen").Protect, AllowComments = True
Worksheets("Sicherung").Unprotect
Sheets("Plan").Range("A1:AF76").Copy
Sheets("Sicherung").Range("A1:AF76").PasteSpecial Paste:=xlPasteValues
Worksheets("Sicherung").Cells.Locked = True
Worksheets("Sicherung").Protect
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub