Sub
Aktualisierung()
Dim
Anzahlwert, Datumold, wertzählenwenngleich, letztezeile, letztzeileDS
As
String
Dim
wksZ, wksY, WksX
As
Worksheet
Dim
pvtab
As
PivotTable
Dim
Wertold(1
To
40), Wertnew(1
To
40)
Set
wksZ = Workbooks(
"Abrechnungsmonitoring"
).Worksheets(
"PivotDaten"
)
Set
wksY = Workbooks(
"Abrechnungsmonitoring"
).Worksheets(
"Baum"
)
Set
WksX = Workbooks(
"Abrechnungsmonitoring"
).Worksheets(
"Datensammlung"
)
letztezeile = wksZ.Cells(256, 1).
End
(xlUp).Row
letzteZeileDS = WksX.Cells(256, 1).
End
(xlUp).Row
Datumold = wksY.Cells(2, 27)
Anzahlwert = 0
For
Each
C
In
wksZ.Range(wksZ.Cells(2, 2), wksZ.Cells(2, letztezeile))
Anzahlwert = Anzahlwert + 1
activerow = C.Row
Wertold(Anzahlwert) = wksZ.Cells(activerow, 2)
Next
<span style=
"color:#e74c3c"
>
Set
pvtab = wksZ.PivotTables(
"Werte"
)
Set
rngcopy = pvtab.DataBodyRange
rngcopy.Copy
<span style=
"color:#e74c3c"
>ActiveWorkbook.RefreshAll
wertzählenwenngleich = 0
Anzahlwert = 0
For
Each
C
In
wksZ.Range(wksZ.Cells(2, 2), wksZ.Cells(2, letztezeile))
Anzahlwert = Anzahlwert + 1
activerow = C.Row
Wertnew(Anzahlwert) = wksZ.Cells(activerow, 2)
If
Wertnew(Anzahlwert) = Wertold(Anzahlwert)
Then
wertzählenwenngleich = wertzählenwenngleich + 1
End
If
Next
If
wertzählenwenngleich = Anzahlwert
Then
MsgBox
"Das aktuelle Datum wurde nicht in das Blatt *Baum* geschrieben, da die Daten identisch sind."
Application.CutCopyMode =
False
Exit
Sub
Else
wksY.Cells(2, 27).Value = Format(Now,
"dd.mm.yyyy"
)
wksY.Cells(4, 27).Value = Datumold
<span style=
"color:#e74c3c"
>
With
wksZ.Cells(2, 3)
.PasteSpecial xlPasteValuesAndNumberFormats, Transpose:=
False
End
With
Application.CutCopyMode =
False
Set
pvtab = wksZ.PivotTables(
"Werte"
)
Set
rngcopy = pvtab.DataBodyRange
rngcopy.Copy
With
WksX.Cells(letzteZeileDS + 1, 2)
.PasteSpecial xlPasteValuesAndNumberFormats, Transpose:=
True
End
With
WksX.Cells(letzteZeileDS + 1, 1).Value = Format(Now,
"dd.mm.yyyy"
)
Application.CutCopyMode =
False
End
If
End
Sub