PowerPivotTable Drill down - fra ekstern data forbindelse (OLAP kube) VBA
Hey,Jeg sidder med en powerpivot tabel, hvor data kommer fra en ekstern forbindelse, i dette eks. er det fra en OLAP Kube.
Jeg vil gerne kunne lave om på den måde excel laver drill down.
I stedet for at excel opretter ny ark, så skal den placere dataen i et bestemt ark. (når der dobbelt klikkes)
Koden jeg bruger virker på en almindelig tabel, men når det er en pivottabel med ekstern data kan jeg kun få den til at vise 1 linje (Data returned for Sales by Channel, 2008, Catalog (First 1000 rows))
Hvis jeg ændre i koden til at starte på linje 3, dvs der hvor data starter når det er powerpivottabel, kommer dataen med ind, men excel crasher hver gang.
Nogen som har input til hvad der går galt?
Koden:
I VBA modlue:
Public CS$
I ThisWorkSheet:
Private Sub Workbook_NewSheet(ByVal Sh As Object)
If CS <> "" Then
With Application
.ScreenUpdating = False
Dim NR&
With Sheets("DrillDown")
If WorksheetFunction.CountA(.Rows(1)) = 0 Then
NR = 1
Else
NR = .Cells.Find(What:="*", After:=Range("A1"), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 2
End If
Range("A1").CurrentRegion.Copy .Cells(NR, 1)
End With
.DisplayAlerts = False
ActiveSheet.Delete
.DisplayAlerts = True
Sheets(CS).Select
.ScreenUpdating = True
End With
End If
End Sub
Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
If ActiveSheet.PivotTables.Count > 0 Then
CS = ActiveSheet.Name
ElseIf ActiveSheet.Name = "DrillDown" Then
If Not IsEmpty(Target) Then
If Target.Row > Range("A1").CurrentRegion.Rows.Count + 1 _
Or Target.CurrentRegion.Cells(1, 1).Address = "$A$1" Then
Cancel = True
With Target.CurrentRegion
.Resize(.Rows.Count + 1).EntireRow.Delete
End With
End If
End If
End If
End Sub