pivot data copy data (Excel 2000)

Topic

New Reply

I need a way to copy pivot table data down the column. Here is the scenario. Data is dumped into Excel from a larger source. I create a pivot table so the data detail is summarized. This data will be exported to Cognos. Before this step I need the data in column A to be copied down the section of the pivot table. Since this can not be done in a pivot table, I copied the table to another sheet. I think I need a macro that will first copy the pivot table (no matter what size) to another sheet and then copy the information in column A down into the blank cells. When the next data is found, the previous copy needs to stop and start a new copy/past proceedure. The distance between the sections will always vary depending on the amount of data from the pivot table. Can you help me? See Attachment.

Reply | Quote

Replies

You can run this code from the worksheet containing the pivot table:

Sub CopyAndFill()
Dim lngRow As Long
ActiveSheet.PivotTables(1).TableRange2.Copy
Worksheets.Add
Selection.PasteSpecial Paste:=xlPasteValues
Selection.PasteSpecial Paste:=xlPasteFormats
For lngRow = 2 To Range(“A65536”).End(xlUp).Row
If Cells(lngRow, 1) = “” Then
Cells(lngRow, 1) = Cells(lngRow – 1, 1)
End If
Next lngRow
End Sub

Reply | Quote

Thank you. You are awesome. I appreciate this.

Reply | Quote

Hans, I need a way to perform this macro on several columns of the pivot table. Is it possible to perform this macro in column A and proceeding into B, C, D, etc. if necessary? I basically need a way to copy the data if the cell is blank. thank you.

Reply | Quote

I have split the macro into two parts:
– Copying the pivot table to a new sheet.
– Filling the gaps in specified columns.

Sub CopyPivot()
ActiveSheet.PivotTables(1).TableRange2.Copy
Worksheets.Add After:=Worksheets(Worksheets.Count)
Selection.PasteSpecial Paste:=xlPasteValues
Selection.PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
End Sub

Sub FillColumns(ParamArray varCols())
Dim lngRow As Long
Dim i As Long
Dim lngCol As Long
For i = LBound(varCols) To UBound(varCols)
lngCol = varCols(i)
For lngRow = 2 To Range(“A65536”).End(xlUp).Row
If Cells(lngRow, lngCol) = “” Then
Cells(lngRow, lngCol) = Cells(lngRow – 1, lngCol)
End If
Next lngRow
Next i
End Sub

Sub CopyAndFill()
CopyPivot
‘ Modify as needed
FillColumns 1, 2, 4
End Sub

As before, CopyAndFill is the macro to run. In this example, the gaps in columns 1, 2 and 4 (i.e. A, B and D) are filled. Adjust as needed.

Reply | Quote