AW: Fehlermeldung 438
04.03.2016 11:26:38
Nicole
Also das ist des Komplette Makro
Sub los()
Application.ScreenUpdating = False
Select Case ActiveSheet.ToggleButton1.Value
Case Is = True
lzeile2 = Sheets("VIB-Filter").Cells(Rows.Count, 1).End(xlUp).Row
If lzeile2 = 1 Then
MsgBox "keine VIB im Register 'VIB-Filter' hinterlegt !", vbCritical, "INFO"
ActiveSheet.ToggleButton1.Value = False
Exit Sub
End If
Sheets("Daten").Select
lzeile = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Application.CutCopyMode = False
Range("G1").Copy
Range("G20:G" & lzeile).Select
Selection.PasteSpecial Paste:=xlFormulas
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues
Sheets("PIVOT").Select
Range("I24").Select
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Filter")
.Orientation = xlPageField
.Position = 1
End With
ActiveSheet.PivotTables("PivotTable1").PivotCache.Refresh
On Error GoTo Fehler
ActiveSheet.PivotTables("PivotTable1").PivotFields("Filter").CurrentPage = "x"
GoTo weiter
Fehler:
MsgBox "keine VIB für Selektion gefunden !", vbCritical, "INFO"
ActiveSheet.ToggleButton1.Value = False
Exit Sub
weiter:
Application.ScreenUpdating = True
Range("a1").Select
ActiveSheet.ToggleButton1.Caption = "VIB-Filter entfernen"
MsgBox "VIB-Filter aktiv !", vbInformation, "INFO"
Case Is = False
Sheets("Daten").Select
lzeile = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
Range("G20:G" & lzeile).Select
Selection.ClearContents
Range("H20").Select
Sheets("PIVOT").Select
Range("C14").Select
ActiveSheet.PivotTables("PivotTable1").PivotCache.Refresh
ActiveSheet.PivotTables("PivotTable1").PivotFields("Filter").Orientation = _
xlHidden
Application.ScreenUpdating = True
Range("a1").Select
ActiveSheet.ToggleButton1.Caption = "VIB-Filter aktivieren"
MsgBox "VIB-Filter entfernt !", vbInformation, "INFO"
End Select
End Sub