仅过滤一行数据时复制/粘贴不起作用答案

【问题标题】：Copy/Paste not working when just one row of data filtered仅过滤一行数据时复制/粘贴不起作用
【发布时间】：2021-05-28 13:54:51
【问题描述】：

我有一个按“位置”过滤的数据透视表。然后，我需要将该过滤后的数据透视表复制/粘贴到与过滤的当前“位置”同名的工作表中。只要最终有不止一行数据，这一切都很好。但是，当只有一行数据被过滤时，代码将复制（看似），但当移动到适当的位置表时，它不会粘贴任何数据。

任何帮助将不胜感激。

这是我的代码：

' create the pickup sheets for the deliveries to each location
Dim pt As PivotTable
Dim pf As PivotField
Dim pi As PivotItem
Set pt = ActiveSheet.PivotTables.Item(1)
For Each pf In pt.PageFields
For Each pi In pf.PivotItems
pt.PivotFields(pf.Name).CurrentPage = pi.Name

    Range("A5", Range("A5").End(xlDown).End(xlToRight)).Select 'range A5 so headers not included
    Selection.Copy
    Sheets(pi.Name).Visible = True
    Sheets(pi.Name).Select
    Range("A" & Rows.Count).End(xlUp).Offset(2).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Sheets("Pickup Lists").Select
    Sheets(pi.Name).Visible = False

【问题讨论】：

与其尝试复制数据透视表，不如尝试使用 VBA 创建数据透视表？
我只复制过滤后的数据透视表中的数据行。主要数据不断变化，所以我需要复制以保持每个交货地点的项目运行列表。

标签： excel vba copy paste

【解决方案1】：

我可以在不使用任何数据透视对象的情况下复制数据，因为它不涉及创建新数据透视表，因此通过引用范围值并复制数据应该更快，这是我的解决方案，请随时添加如果您遇到问题：

原始数据（F3为结果）：

这是我正在执行的 VBA 代码：

Sub pivot()

Dim pLastRow As Long, lastCol As Long

pLastRow = Sheet2.Range("A4").End(xlDown).Row - 1
lastCol = Sheet2.Range("A4").End(xlToRight)

Sheet2.Range(Cells(4, 1), Cells(pLastRow, lastCol)).Copy Sheet2.Range("F4")

End Sub

【讨论】：