Laufzeitfehler 1004
17.10.2013 16:09:17
Hendrik
Ich habe keinen Blattschutz.
Es geht dabei um folgenden Code, der eigentlich nur dafür sorgen soll, dass die Kundennummer und KW die in dem Blatt "Preise Übersicht Lieferant" ausgewählt wird auch auf weitere Pivottabellen übertragen/synchronisiert wird:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If ((Target.Row = 3) And (Target.Column = 1)) Then prcSynchronizePivotTab2
If (Target.Row = 3) Then füllen
End Sub
Sub prcSynchronizePivotTab2()Dim pgfPageField(1) As Object
Dim lngPGFPosition(1) As Long
Dim i As Long
On Error GoTo ErrorHandler
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Cursor = xlWait
TabP21.PivotTables(1).PivotCache.Refresh
TabP23.PivotTables(1).PivotFields("Kunden Nr.").CurrentPage = CStr(Me.PivotTables(1).PivotFields("Kunden Nr.").CurrentPage.Value)
TabP23.PivotTables(1).PivotCache.Refresh
TabP24.PivotTables(1).PivotFields("Kunden Nr.").CurrentPage = CStr(Me.PivotTables(1).PivotFields("Kunden Nr.").CurrentPage.Value)
TabP24.PivotTables(1).PivotCache.Refresh
TabP25.PivotTables(1).PivotFields("Kunden Nr.").CurrentPage = CStr(Me.PivotTables(1).PivotFields("Kunden Nr.").CurrentPage.Value)
TabP25.PivotTables(1).PivotCache.Refresh
ErrorHandler:
Application.ScreenUpdating = True
Application.Cursor = xlDefault
Application.EnableEvents = True
End Sub Sub füllen()
Dim i, j, k As Long
Dim Vorlage, Name As String
Dim Tabelle, Inhalt As String
Dim Pivot_Item As PivotItem
Dim Max, Max2 As Long
Vorlage = "Übersicht Preise Lieferant"
For i = 1 To 3
Select Case i
Case 1
Name = "Übersicht Menge Lieferant"
Tabelle = "PivotTable2"
Case 2
Name = "Übersicht Logistik Lieferant"
Tabelle = "PivotTable2"
Case 3
Name = "Übersicht DB Lieferant"
Tabelle = "PivotTable2"
End Select
Max = ThisWorkbook.Sheets(Name).PivotTables(Tabelle).PivotFields("KW").PivotItems.Count
For j = 1 To Max
If ThisWorkbook.Sheets(Name).PivotTables(Tabelle).PivotFields("KW").PivotItems(j).Value "" Then
If ThisWorkbook.Sheets(Name).PivotTables(Tabelle).PivotFields("KW").PivotItems(j).Value "(blank)" Then
ThisWorkbook.Sheets(Name).PivotTables(Tabelle).PivotFields("KW").PivotItems(j).Visible = False
Else
ThisWorkbook.Sheets(Name).PivotTables(Tabelle).PivotFields("KW").PivotItems(j).Visible = True
End If
End If
Next j
Next i
k = 1
Do While ThisWorkbook.Sheets(Vorlage).Range("C6").Offset(0, k) ""
' If ThisWorkbook.Sheets(Vorlage).Range("C6").Offset(0, k) "" Then
Inhalt = ThisWorkbook.Sheets(Vorlage).Range("C6").Offset(0, k)
For i = 1 To 3
Select Case i
Case 1
Name = "Übersicht Menge Lieferant"
Tabelle = "PivotTable2"
Case 2
Name = "Übersicht Logistik Lieferant"
Tabelle = "PivotTable2"
Case 3
Name = "Übersicht DB Lieferant"
Tabelle = "PivotTable2"
End Select
Max = ThisWorkbook.Sheets(Name).PivotTables(Tabelle).PivotFields("KW").PivotItems.Count
For j = 1 To Max
If ThisWorkbook.Sheets(Name).PivotTables(Tabelle).PivotFields("KW").PivotItems(j).Value = Inhalt Then
ThisWorkbook.Sheets(Name).PivotTables(Tabelle).PivotFields("KW").PivotItems(j).Visible = True End If
Next j
Next i
' End If
k = k + 2
Loop
End Sub
Als Fehlerhaft wird das fettmarkierte dargestellt. Ich bin leider ratlos und hoffe sehr auf Hilfe und Rat.
Vielen Dank für jeden Hinweis.
Hendrik