Hallo an die VBA-Spezialistinnen und Spezialisten
Nach stundenlangem Error and Trail bitte ich euch um Support. Grundsätzlich funktioniert mein Code. Eine ListObject-Tabelle fragt die Werte aus einer Pivot-Tabelle ab. Es gibt 4 verschiedene Datenschnitte, wobei der Wichtigste der "TagTyp" ist. Je nach Selektion muss die ListObject-Tabelle anders befüllt werden. Dieser Filterwert ist fix in Zelle G13.
----- Problem 1:
Mit zunehmender Nutzung wird der Bereich der leeren Zellen unterhalb der ListObject-Tabelle immer wie länger. Was kann ich tun, damit das nicht passiert?
----- Problem 2:
Im Sheet "Hilfspivot" ist ein Worksheet-Change eingefügt. Dieser triggert den Wert in Zelle G13. Warum springt das Makro "DatenUpdate" immer wieder in diesen Change-Befehl - auch wenn sich am Wert von Zelle G13 nichts ändert? Also bloss einer der anderen 3 Datenschnitte sich ändern? Hat diese damit zu tun, dass die Pivot-Tabelle dennoch immer als Ganzes aktualisiert wird?
1. Code
Private Sub Worksheet_Change(ByVal Target As Range)
Dim filter As Variant
filtercell = Range("TagTyp").Address
If Intersect(Target, Range(filtercell)) Is Nothing Then Exit Sub
'MsgBox filtercell
Call DatenUpdate
End Sub
2. Code
Sub DatenUpdate()
Application.ScreenUpdating = False
'--------------------------------------------
' START - Tabellenbody leeren
'--------------------------------------------
Dim tbl As ListObject
Dim lz As Long
Set tbl = Sheets("Hilfspivot").ListObjects("tb_source_full")
If tbl.ListRows.Count >= 1 Then
tbl.DataBodyRange.Delete
End If

'-------------------------------------
' START - Range Pivottabelle abfragen -> piv_bic_source
'-------------------------------------
Dim pt As PivotTable
Set pt = Sheets("Hilfspivot").PivotTables("piv_bic_source")
rngPivot = Union(pt.DataBodyRange, pt.PivotFields(1).DataRange).Address
'--------------------------------------------
' START - Tabellenbody neu befüllen vom Start- bis Enddatum
'--------------------------------------------
Dim datum As Date
Dim start As Date
Dim ende As Date
Dim newRow As ListRow
Dim filter As Variant
filter = Range("TagTyp")
start = Range("Datum_START")
ende = Range("Datum_ENDE")
If filter = "WE" Then
For datum = start To ende
If Weekday(datum, 2) > 5 Then
Set newRow = tbl.ListRows.Add
With newRow
.Range(1) = datum
.Range(2) = filter
.Range(3) = "=IFERROR(VLOOKUP([@Datum], " & rngPivot & " ,2,FALSE),0)"
End With
End If
Next datum

ElseIf filter = "WT" Then
For datum = start To ende
If Weekday(datum, 2) Set newRow = tbl.ListRows.Add
With newRow
.Range(1) = datum
.Range(2) = filter
.Range(3) = "=IFERROR(VLOOKUP([@Datum], " & rngPivot & " ,2,FALSE),0)"
End With
End If
Next datum
Else
For datum = start To ende
Set newRow = tbl.ListRows.Add
With newRow
.Range(1) = datum
.Range(2) = "=IF(WEEKDAY([@Datum],2) >5,""WE"",""WT"")"
.Range(3) = "=IFERROR(VLOOKUP([@Datum], " & rngPivot & " ,2,FALSE),0)"
End With
Next datum
End If
Application.ScreenUpdating = True
End Sub

Danke bestens!