求助：修复为工作簿各工作表生成同表Pivot Table的VBA脚本

原代码的核心问题 #

• 变量名拼写错误：SorceRange应为SourceRange
• 数据源范围未绑定目标工作表：原代码的SourceRange默认取活动工作表范围，而非循环中的目标工作表
• 错误的数据源引用方式：Sheets(x).SourceRange是非法写法，SourceRange是独立变量，不能通过工作表对象调用
• 数据透视表名称重复：所有透视表用同一个名称会触发重复命名报错
• 循环逻辑混乱：同时使用For Each Worksheet和索引变量x，导致逻辑冲突
• 未处理空数据场景：End(xlDown)若遇到空行会错误定位到工作表最后一行

修复后的代码 #

Sub Ptloop()
    Dim x As Long
    Dim sourceRange As Range
    Dim targetSheet As Worksheet
    Dim pivotCache As PivotCache
    Dim pivotTable As PivotTable
    Dim lastRow As Long
    Dim lastCol As Long
    
    ' 起始工作表索引（第4个工作表）
    x = 4
    ' 目标处理的最后一个工作表索引
    Dim k As Long
    k = 75
    
    ' 确保k不超过工作簿实际工作表数量
    If k > ActiveWorkbook.Sheets.Count Then
        k = ActiveWorkbook.Sheets.Count
    End If
    
    ' 循环处理第4到第k个工作表
    Do While x <= k
        Set targetSheet = ActiveWorkbook.Sheets(x)
        
        ' 定位目标工作表的实际数据范围（避免空行导致的错误）
        With targetSheet
            lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
            lastCol = .Cells(4, .Columns.Count).End(xlToLeft).Column
            ' 确保数据至少有一行（A4到lastRow）
            If lastRow >= 4 Then
                Set sourceRange = .Range(.Cells(4, 1), .Cells(lastRow, lastCol))
            Else
                ' 无有效数据，跳过当前工作表
                x = x + 1
                GoTo ContinueLoop
            End If
        End With
        
        ' 创建透视缓存
        Set pivotCache = ActiveWorkbook.PivotCaches.Create( _
            SourceType:=xlDatabase, _
            SourceData:=sourceRange, _
            Version:=xlPivotTableVersion14)
        
        ' 检查当前工作表是否已存在同名透视表，避免报错
        On Error Resume Next
        Set pivotTable = targetSheet.PivotTables("PivotTable_" & targetSheet.Name)
        On Error GoTo 0
        
        If pivotTable Is Nothing Then
            ' 创建新透视表，放在当前工作表的U4位置（第21列）
            Set pivotTable = pivotCache.CreatePivotTable( _
                TableDestination:=targetSheet.Cells(4, 21), _
                TableName:="PivotTable_" & targetSheet.Name, _
                DefaultVersion:=xlPivotTableVersion14)
        Else
            ' 若已存在，刷新透视表数据
            pivotTable.PivotCache.Refresh
        End If
        
ContinueLoop:
        x = x + 1
    Loop
End Sub

关键修复说明 #

• 改用索引循环处理第4到第75个工作表，逻辑更清晰
• 每个工作表的数据源范围单独计算，绑定到目标工作表，避免活动工作表干扰
• 透视表名称使用PivotTable_+工作表名，确保唯一性
• 增加空数据判断，跳过无有效数据的工作表
• 增加重复透视表检查，已存在则刷新而非重复创建
• 限制k不超过实际工作表数量，避免索引越界

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