PowerPivot: exporting pivot table without ThisWorkbookDataModel or any Queries

[datasetleo]

Hi, All

I am looking for exporting powerpivot tables as a regular xlsx table without end-user's option to access pivot data.

When dealing with PowerPivot, I can VBA an export and delete the queries and ThisWorkbookDataModel if the table comes only from a single query/tables from the model - this works as expected.

However, if the pivot table uses multiple tables/queries, the export's layout is damaged when removing ThisWorkbookDataModel.  data from the source sheet stays, and anything from the other tables is removed once ThisWorkbookDataModel is gone.

Any way to export pivottables, remove ThisWorkbookDataModel, even if done from many instances of the datamodel?

Thanks!

[Jimmy801]

Hello @datasetleo 

I don't unsterstand your requirement at 100 %.

The end-user should open the Excel-file and with that the Datamodel should be exportet to a sheet in this file and the datamodel deleted right afterwards?

There is no way to lock the datamodel access as I know. You could create some VBA that queries the datamodel using DAX and delete the datamodel afterwards. But what if the user opens the file not enabling macros?

If this post helps or solves your problem, please mark it as solution.
Kudos are nice to - thanks
Have fun

Jimmy

[datasetleo]

@Jimmy801  Thanks Jimmy for the reply.

This is what I'd like to do.

1- I have a Powerpivot picking up fields from multiple tables (using data model)

2- duplicating sheet into a new workbook (e.g. exporting the table). 

** up to this point, I'll have a copy of the pivot, with query and data model access due to copy.

3- on a new workbook with copied powerpivot, delete all queries and delete ThisWorkbookDataModel connection to avoid users to do more queries or access data.

Note:

I have been able to do this successfully on powerpivot coming from a single table; however, when pivot comes from multiple tables, data is removed as soon as I delete the connection.

I was wondering if there is a logic for this scenario. Let me know any questions and thanks again

[Jimmy801]

Hello @datasetleo 

to summarize it... you have a file with an pivot (also more then one) in it that is connected to power pivot and you want to create a copy for an enduser that sees only the pure pivot data. Is this correct?

In this case you could create a VBA that creates a new workbook and pasting only the raw data of your pivots in it (deleting all connections whatsoever).

If this post helps or solves your problem, please mark it as solution.
Kudos are nice to - thanks
Have fun

Jimmy

[datasetleo]

Thanks @Jimmy801  - I created the VBA and it only works if powerpivot comes from a single query.

Powerpivot has some styling that I'd like to keep, so copying just the values may not be 100% helpful in this case.

It would be great to find a solution to make VBA work even if powerpivot comes from different queries! or find a way to copy/paste powerpivot data & styling without the connections?

[Jimmy801]

Hello
are there any news on this topic? Did solve or help any reply your problem?
If this is the case, please mark it as solution.

Jimmy

[datasetleo]

Thanks, @Jimmy801  - this is looking great. can I ask you a big favor? what's the easiest way to custom the macro, so that, it copies only a few sheets and not all of them? that is, say I have X and Y - it does both, and not all of them?

Thanks again for your time, effort and insights! 

[Jimmy801]

Hello @datasetleo 

If the solution works, please mark the post as solution to clean up the forum (helping other to identify solved issued and find the solution immediately) and to thank the contributor for their work.

About your request. The most simple way would be to hide the sheet, as the program copies only visible sheets. However, you can also hardcode it

- in adding this statement after the "for each ... " statement: if ws.name = "firstsheet" or ws.name = "secondsheet" then

- in adding end if before the next statement

If this post helps or solves your problem, please mark it as solution.
Kudos are nice to - thanks
Have fun

Jimmy

[datasetleo]

Thanks, @Jimmy801 !

[Jimmy801 · Accepted solution]

Hello @datasetleo ,

if only the contents of your sheets should be copied to a new workbook, you can use this code. Formatting is considered.

Option Explicit

Public Ws As Worksheet

Sub ExtractDataToExcel()
    Dim Wb As Workbook
    Dim TWb As Workbook
    Dim WsEx As Worksheet
    Dim V As Integer 'voreinstellungswert für anzahl arbeitsblätter
    Dim C As Integer ' columns
    Dim Pa As Range
    Dim WsC As Integer
    Dim Zoom As Integer
    On Error Resume Next

 
    Application.ScreenUpdating = False
    V = Application.SheetsInNewWorkbook
    Application.SheetsInNewWorkbook = 1
    Set TWb = ThisWorkbook
    Set Wb = Workbooks.Add
    WsC = 1


    For Each WsEx In TWb.Worksheets
        If WsEx.Visible = xlSheetVisible Then
            WsEx.Activate
            Cells.Select
            Selection.Copy
            Wb.Sheets(WsC).Activate
            Set Ws = Wb.Worksheets.Add
            Ws.Name = WsEx.Name
            Ws.Cells.Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            Ws.PageSetup.PrintArea = Ws.UsedRange.Address
            With Ws.PageSetup
                .CenterHeader = WsEx.PageSetup.CenterHeader
                .CenterFooter = WsEx.PageSetup.CenterFooter
                .LeftMargin = WsEx.PageSetup.LeftMargin
                .RightMargin = WsEx.PageSetup.RightMargin
                .TopMargin = WsEx.PageSetup.TopMargin
                .BottomMargin = WsEx.PageSetup.BottomMargin
                .HeaderMargin = WsEx.PageSetup.HeaderMargin
                .FooterMargin = WsEx.PageSetup.FooterMargin
                .Zoom = WsEx.PageSetup.Zoom
                .FitToPagesWide = WsEx.PageSetup.FitToPagesWide
                .FitToPagesTall = WsEx.PageSetup.FitToPagesTall
                .CenterHorizontally = WsEx.PageSetup.CenterHorizontally
                .CenterVertically = WsEx.PageSetup.CenterVertically
                .PaperSize = WsEx.PageSetup.PaperSize
                .Orientation = WsEx.PageSetup.Orientation
                .PrintTitleRows = WsEx.PageSetup.PrintTitleRows

            End With

            WsEx.Activate
            Zoom = ActiveWindow.Zoom
            Ws.Activate
            ActiveWindow.Zoom = Zoom
            Dim Cell As Range
            Dim Zrow As Long
            Dim Zcolumn As Long

            If WsEx.PivotTables.Count > 0 Then
                For Each Cell In WsEx.UsedRange
                    Zrow = Cell.Row
                    Zcolumn = Cell.Column
                    If Intersect(Cell, WsEx.PivotTables(1).TableRange1) Is Nothing Then
                        Else
                        Ws.Cells(Zrow, Zcolumn).Interior.Color = Cell.PivotCell.Range.DisplayFormat.Interior.Color
                    End If
                Next Cell

            End If

            WsC = WsC + 1
        End If
 
    Next WsEx

    If WsC > 1 Then
   
        Application.DisplayAlerts = False
        Wb.Worksheets(WsC).Delete
        Application.DisplayAlerts = True
    End If

    Application.SheetsInNewWorkbook = V
    Application.ScreenUpdating = True

    Exit Sub

End Sub

 

If this post helps or solves your problem, please mark it as solution.
Kudos are nice to - thanks
Have fun

Jimmy