Import data from another workbook pivot.

[SamarthSalunkhe]

Hi All,

I am trying to use the below code to import data from another workbook, I am not getting any errors but the code is not importing data.

Sub Get_Data_From_File()

Dim FileToOpen As Variant

Dim OpenBook As Workbook

Application.ScreenUpdating = False

FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="Excel Files (*.xls*),*xls*")

If FileToOpen <> False Then

Set OpenBook = Application.Workbooks.Open(FileToOpen)

OpenBook.Sheets(1).Activate

ActiveSheet.PivotTables("PivotTable4").PivotSelect "", xlDataAndLabel, True

Selection.Copy

Sheets("Sheet1").Range("C4").PasteSpecial xlPasteValues

Application.CutCopyMode = False

OpenBook.Close False

End If

Application.ScreenUpdating = True

End Sub

 

[BSALV]

use tablerange1 or tabelrange 2

ActiveSheet.PivotTables("PivotTable4").TableRange1.Copy

Referencing an Excel Pivot Table Range using VBA

 

[Alex Blakenburg]

This line is copying to the activeworkbook which is the newly opened workbook.

Sheets("Sheet1").Range("C4").PasteSpecial xlPasteValues

Should it perhaps be

ThisWorkbook.Sheets("Sheet1").Range("C4").PasteSpecial xlPasteValues

 

[SamarthSalunkhe]

Hi @Alex Blakenburg

Code is working now, is it possible to copy pivot table data without header and footer, could you please help with it?

Available Pivot

Imported Data should be.

Sub Get_Data_From_File()
    
    Dim FileToOpen As Variant
    Dim OpenBook As Workbook
    Application.ScreenUpdating = False
    FileToOpen = Application.GetOpenFilename(Title:="Browse for your File & Import Range", FileFilter:="Excel Files (*.xls*),*xls*")
    
    If FileToOpen <> False Then
    
        Set OpenBook = Application.Workbooks.Open(FileToOpen)
        OpenBook.Sheets(1).Activate
        ActiveSheet.PivotTables("PivotTable1").PivotSelect "", xlDataAndLabel, True
        Selection.Copy
        ThisWorkbook.Sheets("Input Data").Range("C3").PasteSpecial xlPasteValues
        Application.CutCopyMode = False
        
        OpenBook.Close False
    End If
    
    Application.ScreenUpdating = True
End Sub

 

[BSALV]

ADVERTISEMENT

 With ActiveSheet.PivotTables("Pivottable4")
          i = .ColumnRange.Rows.Count
          With .TableRange2                                     'that range of the pivottable
               .Offset(i).Resize(.Rows.Count - i + IIf(.Cells(.Rows.Count, 1).Value = "Grand Total", -1, 0)).Copy     'eventually without the grandtotals
          End With
     End With

 

[SamarthSalunkhe]

 With ActiveSheet.PivotTables("Pivottable4")
          i = .ColumnRange.Rows.Count
          With .TableRange2                                     'that range of the pivottable
               .Offset(i).Resize(.Rows.Count - i + IIf(.Cells(.Rows.Count, 1).Value = "Grand Total", -1, 0)).Copy     'eventually without the grandtotals
          End With
     End With

Hi @BSALV

I have tried the above modification but I'm facing the below error, sorry I'm not able to resolve it as I am a beginner in VBA.

Could you please check below code.

Sub Get_Data_From_File()

Dim FileToOpen As Variant

Dim OpenBook As Workbook

Application.ScreenUpdating = False

FileToOpen = Application.GetOpenFilename(Title:="Browse for your File", FileFilter:="Excel Files (*.xls*),*xls*")

If FileToOpen <> False Then

Set OpenBook = Application.Workbooks.Open(FileToOpen)

OpenBook.Sheets(1).Activate



With ActiveSheet.PivotTables("PivotTable1")

i = .ColumnRange.Rows.Count

With .TableRange2

.Offset(i).Resize(.Rows.Count - i + IIf(.Cells(.Rows.Count, 1).Value = "Grand Total", -1, 0)).Copy

End With

End With

ThisWorkbook.Sheets("Input Data").Range("C3").PasteSpecial xlPasteValues

Application.CutCopyMode = False

OpenBook.Close False

End If

Application.ScreenUpdating = True

End Sub

 

[Alex Blakenburg]

ADVERTISEMENT

I have tried @BSALV code and it relies on the pivot having at least one dimension added to the Columns area. If it doesn't find that it errors out.

Try replacing that code with this.
I am sure there are better ways of doing it rather than relying using 'on error' but it should do the trick.

    Dim i As Long
    i = 1
    With ActiveSheet.PivotTables("Pivottable1")
        On Error Resume Next
        i = .ColumnRange.Rows.Count
        On Error GoTo 0

        With .TableRange2                                     'that range of the pivottable
            .Offset(i).Resize(.Rows.Count - i + IIf(.Cells(.Rows.Count, 1).Value = "Grand Total", -1, 0)).Copy    'eventually without the grandtotals
        End With
    End With

 

[SamarthSalunkhe]

I have tried @BSALV code and it relies on the pivot having at least one dimension added to the Columns area. If it doesn't find that it errors out.

Try replacing that code with this.
I am sure there are better ways of doing it rather than relying using 'on error' but it should do the trick.

    Dim i As Long
    i = 1
    With ActiveSheet.PivotTables("Pivottable1")
        On Error Resume Next
        i = .ColumnRange.Rows.Count
        On Error GoTo 0

        With .TableRange2                                     'that range of the pivottable
            .Offset(i).Resize(.Rows.Count - i + IIf(.Cells(.Rows.Count, 1).Value = "Grand Total", -1, 0)).Copy    'eventually without the grandtotals
        End With
    End With

Hi @Alex Blakenburg,

Thank you so much for your help, code is working fine now.

 

[BSALV]

without "on error", with the ranges for TableRange1 and Databodyrange (there is still the possibility that databodyrange doesn't exists if you didn't select pivotfields for it !)
This did the trick on my pivottable, adapt the address for pastespecial and the name of the pivottable

Sub Samarth()
     With ActiveSheet.PivotTables(1)
          Set c1 = .TableRange1
          Set c2 = .DataBodyRange
          i = c2.Row - c1.Row                                   'difference between 1st row of .tablerange1 and 1st row of .databodyrange

          With .TableRange1                                     'that range of the pivottable
               b = (StrComp(.Cells(.Rows.Count, 1).Value, "Grand Total", vbTextCompare) = 0)     'check if last cell of TableRange1 is "Grand Total" (value is true/false or 0/-1 !!!
               Set c3 = .Offset(i).Resize(.Rows.Count - i + b)
               c3.Copy
               ActiveSheet.Range("A20").PasteSpecial xlValues   'Offset(, 4)    'eventually without the grandtotals
          End With
     End With

     MsgBox "TableRange1 : " & c1.Address & vbLf & "Databodyrange : " & c2.Address & vbLf & "Samarth : " & c3.Address

End Sub

 

[SamarthSalunkhe]

without "on error", with the ranges for TableRange1 and Databodyrange (there is still the possibility that databodyrange doesn't exists if you didn't select pivotfields for it !)
This did the trick on my pivottable, adapt the address for pastespecial and the name of the pivottable

Sub Samarth()
     With ActiveSheet.PivotTables(1)
          Set c1 = .TableRange1
          Set c2 = .DataBodyRange
          i = c2.Row - c1.Row                                   'difference between 1st row of .tablerange1 and 1st row of .databodyrange

          With .TableRange1                                     'that range of the pivottable
               b = (StrComp(.Cells(.Rows.Count, 1).Value, "Grand Total", vbTextCompare) = 0)     'check if last cell of TableRange1 is "Grand Total" (value is true/false or 0/-1 !!!
               Set c3 = .Offset(i).Resize(.Rows.Count - i + b)
               c3.Copy
               ActiveSheet.Range("A20").PasteSpecial xlValues   'Offset(, 4)    'eventually without the grandtotals
          End With
     End With

     MsgBox "TableRange1 : " & c1.Address & vbLf & "Databodyrange : " & c2.Address & vbLf & "Samarth : " & c3.Address

End Sub

Hi @BSALV

Thank you so much for your idea's and help.