Sub Filterübertragen()
Dim i, j, x, kw As Integer
Dim line As String
Dim A, B As Worksheet
Dim Piv As PivotField
i = 3
j = 2
'Workbooks.Open Filename:="H:\Daten\A.xlsx"
'Workbooks.Open Filename:="H:\Daten\B.xlsx"
Set A = Workbooks("A.xlsx").Sheets("TabelleX")
Set B = Workbooks("B.xlsx").Sheets("TabelleY")
Set Piv = A.PivotTables("PivotTable2").PivotFields("c2")
B.Activate
Do Until Cells(2, j) = ""
j = j + 1
Loop
B.Range(Cells(2, j - 1), Cells(77, j - 1)).Copy
B.Cells(2, j).PasteSpecial
x = Cells(2, j - 1)
kw = Mid$(x, 3)
Cells(2, j) = "KW" & kw + 1
Do Until Cells(i, 3) = ""
line = B.Cells(i, 3)
If line = "a" Or line = "b" Or line = "c" Or line = "d" Or line = "e" Then
B.Cells(i, j) = 0
Else
Piv.CurrentPage = (line)
Calculate
A.Range("F17").Copy
B.Cells(i, j).PasteSpecial Paste:=xlPasteValues
End If
i = i + 1
Loop
B.ChartObjects("Diagramm 1").Activate
ActiveChart.SetSourceData Source:=Range(Cells(2, 3), Cells(77, j))
End Sub