How do I cahnge this code to give a drill through on the same sheet but just next to the current cel

[Ajay Garg]

I am using the below menstioned code to create a drill through from an
excel pivot table to an OLAP cube.In the last part of the code I am
adding a new work sheet and inseting the drill through results at a
range = a1.I am reporoducing it seperately.

Add a new worksheet.
Set ws = Worksheets.Add

' Add a QueryTable to the worksheet. Connect the query table to
' the recordset that contains the results of the MDX statement.
With ws.QueryTables.Add(Connection:=rs,
Destination:=ws.Range("A1"))

.Refresh

End With

---Code for drill through...
Sub Drillthrough()

Dim Cat As ADOMD.Catalog
Dim Conn As ADODB.Connection
Dim qry As String
Dim pcell As PivotCell
Dim pt As PivotTable
Dim i As Integer
Dim rs As ADODB.Recordset
Dim iAxisNum As Integer
Dim sDrillQry As String

' Set a variable to the PicotCell object of the active cell.
Set pcell = ActiveCell.PivotCell

' If the cell isn't part of an OLAP PivotTable, then call
' the errmsg error handler.
If Not (pcell.PivotTable.PivotCache.OLAP) Then GoTo errmsg

' If the cell isn't in the data area of the PivotTable, then
' call the errmsg error handler.
If pcell.PivotCellType <> xlPivotCellValue Then GoTo errmsg

Set pt = pcell.PivotTable

' Make sure that the PivotTable's cache is connected
' to the data source.
If Not pt.PivotCache.IsConnected Then
pt.PivotCache.MakeConnection
End If
' Create a new Catalog.
Set Cat = New ADOMD.Catalog

' Create a new connection.
Set Conn = New ADODB.Connection

' Set up the ADOMD catalog.
Set Cat.ActiveConnection = pt.PivotCache.ADOConnection

' Set up the ADO connection.
Set Conn = pt.PivotCache.ADOConnection

sDrillQry = "Drillthrough maxrows 2500 Select "

' Loop through row items. The outermost items will be added to
' the MDX statement.
For i = 1 To pcell.RowItems.Count - 1

If pcell.RowItems(i).Parent.CubeField.Name <> _
pcell.RowItems(i + 1).Parent.CubeField.Name Then

' Append the item to the MDX statement.
sDrillQry = sDrillQry & "{" & pcell.RowItems(i) & _
"} on " & iAxisNum & ", "

' Increment the axis dimension.
iAxisNum = iAxisNum + 1

End If

Next i

' Add the innermost row item if more than one item has been added
' to the row axis.
If pcell.RowItems.Count > 0 Then

' Append the item to the MDX statement.
sDrillQry = sDrillQry & "{" & pcell.RowItems(i) & _
"} on " & iAxisNum & ", "
' Increment the axis dimension.
iAxisNum = iAxisNum + 1

End If

' Loop through row items. The outermost items will be added to
' the MDX statement.
For i = 1 To pcell.ColumnItems.Count - 1

If pcell.ColumnItems(i).Parent.CubeField.Name <> _
pcell.ColumnItems(i + 1).Parent.CubeField.Name Then

' Append the item to the MDX statement.
sDrillQry = sDrillQry & "{" & pcell.RowItems(i) & _
"} on " & iAxisNum & ", "

' Increment the axis dimension.
iAxisNum = iAxisNum + 1

End If
Next i

' Add the innermost column item if more than one item has been
added
' to the column axis.
If pcell.ColumnItems.Count > 0 Then

' Append the item to the MDX statement.
sDrillQry = sDrillQry & "{" & pcell.ColumnItems(i) _
& "} on " & iAxisNum & ", "

' Increment the axis dimension.
iAxisNum = iAxisNum + 1

End If

' Loop through the visible page items.
For i = 1 To pt.PageFields.Count

' Append the item to the MDX statement.
sDrillQry = sDrillQry & "{" & pt.PageFields(i).CurrentPageName _
& "} on " & iAxisNum & ", "

' Increment the axis dimension.
iAxisNum = iAxisNum + 1

Next i
' Remove the trailing ", ".
sDrillQry = Left$(sDrillQry, Len(sDrillQry) - 2)

' Add the cube name to the MDX statement.
sDrillQry = sDrillQry & " From " & "[" & _
pt.PivotCache.CommandText & "]"

' Create a new recordset
Set rs = New ADODB.Recordset

On Error GoTo errmsg

With rs


' Pass the MDX atatement to the recordset.
.Source = sDrillQry

Set .ActiveConnection = Conn

' Open the recordset.
.Open
End With
On Error GoTo 0

' Add a new worksheet.
Set ws = Worksheets.Add

' Add a QueryTable to the worksheet. Connect the query table to
' the recordset that contains the results of the MDX statement.
With ws.QueryTables.Add(Connection:=rs,
Destination:=ws.Range("A1"))

.Refresh

End With

Exit Sub

errmsg:
MsgBox "Cannot Drillthrough on this selection."
End Sub
----This is based on the artile that is given in the link below....

http://msdn.microsoft.com/library/default.asp?url=/library/en-us/dnexcl2k2/html/odc_xlextendolap.asp


I want to add the results just besides the item where I am Right
clicking and selectinf drill theough on the pivot....How can i change
the
With ws.QueryTables.Add(Connection:=rs, Destination:=ws.Range("A1"))
in the result set to outpout the result to the current location of the
work sheet?



Thanks in anticipation....


Ajay