How to copy Data in Pivot table rows to the next available blank in new sheet?

Question

So I'm very new to VBA, basically learning it for my first job.

I have data from a filtered pivot table in Sheet3. This data is updated monthly, I need to copy this dynamic data (excluding the headings and the blanks when the data ends) to a new sheet (sheet8) in the next available row as other data will be copied there too from other pivot tables.

What I have tried so far is

    Sub Aggregate_Data()
'
' Aggregate_Data Macro
'
Sheet3.Activate
LR = Sheet3.Cells(Rows.Count, 1).End(xlUp).Row
For i = 3 To LR
If Sheet3.Cells(i, 1).Value <> "0" Then
Sheet3.Rows(i).Copy
Sheet8.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).EntireRow.Select
Selection.PasteSpecial xlPasteValues
End If
Next i
End Sub

I have no idea what I'm doing really, so sorry if this code makes no sense. But basically I keep getting a run-time error "1004"

YowE3K · Answer 1 · 2017-08-04T00:51:50.103

Assuming your error is occurring on the line saying Sheet8.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).EntireRow.Select, it is due to an attempt to Select a range on a worksheet that is not active.

Avoid using Select (and Activate) unless you need to. (Refer How to avoid using Select in Excel VBA macros for more information.)

I believe your code could be rewritten as:

Sub Aggregate_Data()
'
' Aggregate_Data Macro
'
    Dim i As Long
    Dim LR As Long
    Dim j As Long
    Dim c As Long
    'Find last used row in Sheet3
    LR = Sheet3.Cells(Sheet3.Rows.Count, 1).End(xlUp).Row
    'Find last used row in Sheet8
    j = Sheet8.Cells(Sheet8.Rows.Count, 1).End(xlUp).Row
    'Loop through rows on Sheet3
    For i = 3 To LR
        'Decide whether to copy the row or not
        If Sheet3.Cells(i, 1).Value <> "0" Then
            'Update pointer to the next unused row in Sheet8
            j = j + 1
            'Only copy used columns, to stop it thinking every cell in the
            'destination row is "used"
            c = Sheet3.Cells(i, Sheet3.Columns.Count).End(xlToLeft).Column
            'Copy the values (without using Copy/Paste via the clipboard)
            Sheet8.Rows(j).Resize(1, c).Value = Sheet3.Rows(i).Resize(1, c).Value
        End If
    Next i
End Sub

score 0 · Answer 2 · answered Aug 04 '17 at 03:43

It is simple to use Variant.

Dim vDB, vR()
Dim n As Long, i As Long, j As Integer, c As Integer
vDB = Sheet3.Range("a1").CurrentRegion
c = UBound(vDB, 2)
For i = 1 To UBound(vDB, 1)
    If vDB(i, 1) <> 0 Then
        n = n + 1
        ReDim Preserve vR(1 To c, 1 To n)
        For j = 1 To UBound(vDB, 2)
            vR(j, n) = vDB(i, j)
        Next j
    End If
Next i
Sheet8.Range("a1").Resize(n, c) = WorksheetFunction.Transpose(vR)

How to copy Data in Pivot table rows to the next available blank in new sheet?

2 Answers2