Beiträge zum Thread: Umstieg auf Office LTSC Professional Plus 2024

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