Copying and pasting values with unequal data columns

[grexcelman]

I have data that has been filtered into a pivot table from multiple sources. This table consists of 3 columns, I will need to automate a process of copying this data from a range which can change dynamically in size depending on future entries, and I wish to paste into a separate consolidated two column range elsewhere in the worksheet. The issue I'm having is column A and Column B have labels which all correspond to figures in Column C. Column A starts in row 5 but will show a "(blank)" after several labels, this will change over time but always begin at 5, and once that "blank" label is found, the list will continue in column B in the following row. Again all data will remain constant in the third column, but I need to consolidated columns A and B correctly until column B data ends. Hopefully that's clear. Thanks in advance!

[charlesdh]

HI,

Can you attach a redacted copy so we can see what the data looks like.

[grexcelman]

Here's a screen shot of its current form(Pivot table). and another shot of it after its been copy and pasted. I will need to sort it by value afterwards and this process will also get included in the macro.

[charlesdh]

Hi,

Thanks for the images.
I'll make the assumption that the data that will be copied somewhere else in the worksheet will be deleted when you create the next Pivot Table. Is this correct?

[grexcelman]

that's correct. Will be pasting values from the pivot table and whenever a new pivot table is created, I would rerun the macro and that would essentially paste over the last pasted data.

[charlesdh]

Hi,

Here's the code that I have. You can see if it works.
Copy to a module and test on sample data.

Sub Copy_PTData()
Application.ScreenUpdating = False
Dim i As Long
Dim LastRow As Long '' for column A lastrow
Dim Lrow As Long '' fo column E
LastRow = ActiveSheet.Range("A1").SpecialCells(xlCellTypeLastCell).Row
''' Clear the copy range for new input '''
ActiveSheet.Range("E2:F" & ActiveSheet.Range("E65536").End(xlUp).Row).ClearContents
For i = 5 To LastRow
    ''' get last last row of data in column E
    Lrow = ActiveSheet.Range("E65536").End(xlUp).Row + 1
    ''' now loop down column A and copy
    If Cells(i, 1).Text <> "" And Cells(i, 1).Text <> "(blank)" Then ''' not sure about this line
        Cells(Lrow, 5).Value = Cells(i, 1).Text
        Cells(Lrow, 6).Value = Cells(i, 3).Text
    Else '' column A is empty
        Cells(Lrow, 5).Value = Cells(i, 2).Text
        Cells(Lrow, 6).Value = Cells(i, 3).Text
    End If
    If i = LastRow Then
        Cells(Lrow, 6).Value = Cells(i, 3).Text
    End If
Next i
Application.ScreenUpdating = True
End Sub