如何将数据透视表行中的数据复制到新工作表中的下一个可用空白？答案

【问题标题】：How to copy Data in Pivot table rows to the next available blank in new sheet?如何将数据透视表行中的数据复制到新工作表中的下一个可用空白？
【发布时间】：2017-08-04 11:43:20
【问题描述】：

所以我对 VBA 非常陌生，基本上是在我的第一份工作中学习它。

我有来自 Sheet3 中过滤数据透视表的数据。此数据每月更新一次，我需要将此动态数据（数据结束时不包括标题和空白）复制到下一个可用行中的新工作表（sheet8），因为其他数据也将从其他数据透视表复制到那里。

到目前为止我尝试过的是

    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

我真的不知道我在做什么，如果这段代码没有意义，很抱歉。但基本上我一直收到运行时错误“1004”

【问题讨论】：

标签： vba excel

【解决方案1】：

假设您的错误发生在Sheet8.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).EntireRow.Select 行上，这是由于尝试Select 工作表上未激活的范围。

除非需要，否则避免使用Select（和Activate）。（更多信息请参考How to avoid using Select in Excel VBA macros。）

我相信你的代码可以改写为：

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

【讨论】：

【解决方案2】：

使用 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)

【讨论】：