Power Pivot表格VBA代码修复：指定列复制至目标工作表

以下是针对需求优化后的VBA代码，解决了重复粘贴、列定位不精准的问题，同时满足所有功能要求：

Sub FilterPivot()
    Dim wsPivot As Worksheet
    Dim wsReport2 As Worksheet
    Dim pt As PivotTable
    Dim pfReportingName As PivotField
    Dim pfUsage As PivotField
    Dim pfMGPCU As PivotField
    Dim pfDCD As PivotField
    
    ' 绑定工作表和透视表对象
    Set wsPivot = ThisWorkbook.Worksheets("Pivot")
    Set wsReport2 = ThisWorkbook.Worksheets("Report2")
    Set pt = wsPivot.PivotTables("PivotTable1")
    
    ' 取消Report2的I列隐藏
    wsReport2.Columns("I").Hidden = False
    
    ' 按字段名定位目标列（适配数据源结构变化）
    On Error Resume Next
    Set pfReportingName = pt.PivotFields("Reporting Name")
    Set pfUsage = pt.PivotFields("Sum of Usage")
    Set pfMGPCU = pt.PivotFields("Sum of MG/PCU")
    Set pfDCD = pt.PivotFields("Sum of DCD")
    On Error GoTo 0
    
    ' 字段存在性校验
    If pfReportingName Is Nothing Or pfUsage Is Nothing Or pfMGPCU Is Nothing Or pfDCD Is Nothing Then
        MsgBox "数据透视表缺失指定字段，请检查字段名称", vbExclamation
        Exit Sub
    End If
    
    ' 空数据校验
    If pt.DataBodyRange Is Nothing Then
        MsgBox "数据透视表无有效数据", vbInformation
        Exit Sub
    End If
    
    ' 逐个复制数据到目标区域（仅粘贴值，避免覆盖公式）
    pfReportingName.DataRange.Copy
    wsReport2.Range("B97").PasteSpecial xlPasteValues
    
    pfUsage.DataRange.Copy
    wsReport2.Range("C97").PasteSpecial xlPasteValues
    
    pfMGPCU.DataRange.Copy
    wsReport2.Range("E97").PasteSpecial xlPasteValues
    
    pfDCD.DataRange.Copy
    wsReport2.Range("I97").PasteSpecial xlPasteValues
    
    ' 清除剪贴板状态
    Application.CutCopyMode = False
    
    ' 整合现有流程：取消注释并替换为你的宏名称
    ' Call AutoFilterMacro
    ' Call GeneratePDFMacro
    ' Call SendEmailMacro
End Sub

核心修复点说明 #

• 精准字段定位：放弃固定列号，通过字段名称直接绑定透视表列，彻底解决数据源结构变更导致的列错位问题
• 避免重复/误覆盖：仅复制透视表的有效数据区域（不含表头），且逐个粘贴到指定起始单元格，不会覆盖整列或中间带公式的D列
• 鲁棒性增强：添加字段存在性、空数据校验，防止代码因数据异常崩溃
• 流程整合兼容：代码末尾预留了现有宏的调用位置，直接添加对应宏名即可无缝整合到自动筛选、PDF生成及邮件发送流程

内容的提问来源于stack exchange，提问作者Sarah