Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
Solved

# Copying Table (pivot) to different worksheet

Posted on 2011-09-27
Medium Priority
206 Views
``````Function CopyFunction()
Dim lEndRow As Long, lStartRow As Long
Dim num1 As Integer, num2 As Integer

'1st row starts from 3
lStartRow = 3

'last row = grand total and its not included
lEndRow = (Sheets("Pivots").Range("A" & Sheets("Pivots").Rows.Count).End(xlUp).Row) - 1

'First loop assingment
For num1 = lStartRow To lEndRow

'Second loop assignment
For num2 = lStartRow To lEndRow

Next
Next
MsgBox lEndRow
End Function
``````

Hi,

I have a pivot table in a sheet called 'Pivots'

I want to create a new tab - say 'GL Summary' and paste all the pivot table entries into a table on this sheet.

Pivot table has 3 columns (Unique, Sum of Debt, Sum of Credit)

Could you please help me to code this? I am sure its going to be a one liner but looking around,  I see a lot of complext solutions. I am very sure this can be done in one line but  I am bad with ranges :/

Copy-of-GL-Summary---Master-File.xls
0
Question by:Shanan212
[X]
###### Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

• Help others & share knowledge
• Earn cash & points
• 4
• 3

LVL 13

Author Comment

ID: 36711971
``````Function CopyFunction()
Dim lEndRow As Long, lStartRow As Long
Dim num1 As Integer, num2 As Integer
Dim Finals As Worksheet

Finals.Name = "Payroll Summary"

Range("A1").Value = "ID"
Range("B1").Value = "Sum of Debt"
Range("C1").Value = "Sum of Credit"

'1st row starts from 3
lStartRow = 3

'last row = grand total and its not included
lEndRow = (Sheets("Pivots").Range("A" & Sheets("Pivots").Rows.Count).End(xlUp).Row) - 1

'First loop assingment
For num1 = lStartRow To lEndRow

'Second loop assignment
For num2 = lStartRow To lEndRow

Next
Next

Finals.Columns.AutoFit

End Function
``````

I have the above table which now creates the table-to paste the pivot data.

Any help is much appreciated!
0

LVL 42

Expert Comment

ID: 36712042
Copy and pasting the pivot is simple.  However, your GL Summary looks alot more complicated.  Do you want to replace the data, do you want the data pasted in exactly as GL Summary is formed, and why not use a lookup from GL Summary into the pivot data, instead?

Given the optinos, it would be good to read your response before providing a more-focused solution.

Cheers,

Dave
0

LVL 13

Author Comment

ID: 36712091
I only want the pivot data to be copied. Only 3 columns mentioned. I have further amended the function to delete the 'destination' worksheet and recreate a new one (so replacing)

I do want the data pased exactly as the pivot is formed.

Vlookup sounds good but the data on pivot could vary (rows) and it might look ugly

Let me know. This is what I have further compiled using internet research. But the 2 lines of codes inside the loop, I am having tough time with the '_' as my VBA is old and it wouldn't allow it. I am not quite sure how to bring it all on one line!

Any help is appreciated!

``````Function CopyFunction()
Dim lEndRow As Long, lStartRow As Long
Dim num1 As Integer, num2 As Integer
Dim Finals As Worksheet, wssheet As Worksheet

Set wssheet = Sheets("Payroll Summary")

If Not wssheet Is Nothing Then
Worksheets("Payroll Summary").Delete
End If

Finals.Name = "Payroll Summary"

Range("A1").Value = "ID"
Range("B1").Value = "Sum of Debt"
Range("C1").Value = "Sum of Credit"

Dim strThisWs As String
Dim wsEach As Worksheet
Dim rngStart As Range
Dim rngEnd As Range
Dim rngCell As Range
Dim rngDest As Range

With Worksheets("Pivots")

'set start as A2 i.e., after heading row in column A
Set rngStart = .Range("A2")

'set end - last used row in column A
Set rngEnd = .Range("A" & CStr(Application.Rows.Count)).End(xlUp)

'loop through cells in column A
For Each rngCell In .Range(rngStart, rngEnd)

'find next empty row on destination sheet
Set rngDest = Worksheets("CPL Distance") _
.Range("A" & CStr(Application.Rows.Count)) _
.End(xlUp).Offset(1, 0)

'copy & paste entire row
rngCell.EntireRow.Copy _
Destination:=Worksheets("CPL Distance") _

Next rngCell
End With

Finals.Columns.AutoFit

End Function
``````
0

LVL 42

Accepted Solution

dlmille earned 2000 total points
ID: 36712130
That was useful.

``````Option Explicit

Sub TextBox2_Click()

CopyFunction

End Sub
Sub CopyFunction()
Dim lEndRow As Long, lStartRow As Long
Dim num1 As Integer, num2 As Integer
Dim wkb As Workbook
Dim pivotSht As Worksheet, Finals As Worksheet, srcWks As Worksheet
Dim copyRng As Range, pasteRng As Range

Set wkb = ThisWorkbook
Set pivotSht = wkb.Sheets("Pivots")

'put error checking in, to ensure sheet "Payroll Summary" doesn't already exist, or you'll get an error when you set the name to the new sheet
Finals.Name = "Payroll Summary"

Finals.Range("A1:C1") = Split("ID,Sum of Debt,Sum of Credit", ",")

'1st row starts from 3
lStartRow = 3

'last row = grand total and its not included
lEndRow = (pivotSht.Range("A" & pivotSht.Rows.Count).End(xlUp).Row) - 1

Set copyRng = pivotSht.Range("A" & lStartRow, pivotSht.Range("C" & lEndRow))
Set pasteRng = Finals.Range("A2")

'copy values only, not formats
pasteRng.Resize(copyRng.Rows.Count, copyRng.Columns.Count).Value = copyRng.Value

'alternatively,copy with formats
'copyRng.Copy
'pasteRng.PasteSpecial xlPasteAll
'Application.CutCopyMode = False

Finals.Columns.AutoFit

End Sub
``````

See attached, and run the copyFunction subroutine to get results.  Note comments in code, re: error checking needed.

Cheers,

Dave
Copy-of-GL-Summary---Master-File.xls
0

LVL 42

Expert Comment

ID: 36712250
here's the code for determining whether a sheet exists, or not:

dim tstWks as worksheet

on error resume next
set tstWks = sheets("Payroll Summary")
if error.number <> 0 then 'got an error, so sheet must not exist
end if
on error goto 0 'reset error trapping

Cheers,

Dave
0

LVL 42

Expert Comment

ID: 36712273
You don't need to iterate through every row to do the copy.  The code I posted will work, it is tested, and a copy/paste (or range assignment as I did) can be done with an entire range.

Here's what you need to do with the "_":

Set rngDest = Worksheets("CPL Distance") _
.Range("A" & CStr(Application.Rows.Count)) _
.End(xlUp).Offset(1, 0)

'copy & paste entire row
rngCell.EntireRow.Copy _
Destination:=Worksheets("CPL Distance") _

becomes:

Set rngDest = Worksheets("CPL Distance").Range("A" & CStr(Application.Rows.Count)).End(xlUp).Offset(1, 0)

'copy & paste entire row

Cheers,

Dave
0

LVL 13

Author Closing Comment

ID: 36712295
Although the code I pasted worked, this worked as well!

I have saved both for future reference :)

Thanks all!

``````Sub CopyFunction()
Dim lEndRow As Long, lStartRow As Long
Dim num1 As Integer, num2 As Integer
Dim wkb As Workbook
Dim pivotSht As Worksheet, Finals As Worksheet, srcWks As Worksheet, wssheet As Worksheet
Dim copyRng As Range, pasteRng As Range

Set wssheet = Sheets("Payroll Summary")

If Not wssheet Is Nothing Then
Worksheets("Payroll Summary").Delete
End If

Set wkb = ThisWorkbook
Set pivotSht = wkb.Sheets("Pivots")

'put error checking in, to ensure sheet "Payroll Summary" doesn't already exist, or you'll get an error when you set the name to the new sheet
Finals.Name = "Payroll Summary"

Finals.Range("A1:C1") = Split("ID,Sum of Debt,Sum of Credit", ",")

'1st row starts from 3
lStartRow = 3

'last row = grand total and its not included
lEndRow = (pivotSht.Range("A" & pivotSht.Rows.Count).End(xlUp).Row) - 1

Set copyRng = pivotSht.Range("A" & lStartRow, pivotSht.Range("C" & lEndRow))
Set pasteRng = Finals.Range("A2")

'copy values only, not formats
pasteRng.Resize(copyRng.Rows.Count, copyRng.Columns.Count).Value = copyRng.Value

Finals.Columns.AutoFit

End Sub
``````
0

LVL 85

Expert Comment

ID: 36715549
Just as an FYI, the PivotTable object exposes various ranges you can refer to directly:

``````Sub CopyFunction()
Dim lEndRow As Long, lStartRow As Long
Dim num1 As Integer, num2 As Integer
Dim wkb               As Workbook
Dim pivotSht As Worksheet, Finals As Worksheet, srcWks As Worksheet, wssheet As Worksheet
Dim copyRng As Range, pasteRng As Range
Dim PT                As PivotTable

Set wssheet = Sheets("Payroll Summary")

If Not wssheet Is Nothing Then
Worksheets("Payroll Summary").Delete
End If

Set wkb = ThisWorkbook
Set pivotSht = wkb.Sheets("Pivots")

'put error checking in, to ensure sheet "Payroll Summary" doesn't already exist, or you'll get an error when you set the name to the new sheet
Finals.Name = "Payroll Summary"

Set PT = pivotSht.PivotTables(1)

Set pasteRng = Finals.Range("A1")
PT.RowRange.Resize(, PT.TableRange2.Columns.Count).Copy
'copy values only, not formats
pasteRng.PasteSpecial xlPasteValues
Finals.Range("A1:C1") = Split("ID,Sum of Debt,Sum of Credit", ",")

Finals.Columns.AutoFit

End Sub
``````

Regards,
Rory
0

## Featured Post

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article will guide you to convert a grid from a picture into Excel format using Microsoft OneNote and no other 3rd party application.
You need to know the location of the Office templates folder, so that when you create new templates, they are saved to that location, and thus are available for selection when creating new documents.  The steps to find the Templates folder path are â€¦
The viewer will learn how to use a discrete random variable to simulate the return on an investment over a period of years, create a Monte Carlo simulation using the discrete random variable, and create a graph to represent the possible returns overâ€¦
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.
###### Suggested Courses
Course of the Month9 days, 7 hours left to enroll