VBA嵌套循环问题：多工作表数据透视表复用单一数据源

问题根源 #

你的代码中第一个For Each sht循环仅逐个覆盖dataRG变量，循环结束后dataRG只会保留最后一个工作表的数据区域。第二个循环创建透视表时，全程复用这个最终的dataRG，导致所有透视表都使用同一份数据。

修正方案 #

将源工作表遍历与透视表创建合并为一个循环，确保每个透视表都关联对应源工作表的数据区域。以下提供两种实现方式：

方式1：自动匹配源表与透视表名称（推荐） #

自动基于源工作表名称生成对应透视表工作表，无需手动维护名称数组：

Sub CreatePivotTables()
    Dim wb As Workbook
    Dim srcSht As Worksheet
    Dim pvtWs As Worksheet
    Dim dataRG As Range
    Dim pvtCache As PivotCache
    Dim pvtTable As PivotTable
    Dim pvtSheetName As String
    
    Set wb = ActiveWorkbook
    
    ' 遍历所有工作表
    For Each srcSht In wb.Worksheets
        ' 跳过已存在的透视表工作表，避免重复处理
        If Right(srcSht.Name, 6) <> "Pivot" Then
            ' 生成对应的透视表工作表名称
            pvtSheetName = srcSht.Name & " Pivot"
            
            ' 检查透视表工作表是否已存在
            Set pvtWs = Nothing
            On Error Resume Next
            Set pvtWs = wb.Worksheets(pvtSheetName)
            On Error GoTo 0
            
            ' 获取当前源工作表的有效数据区域
            Set dataRG = srcSht.Range("A4").CurrentRegion
            
            ' 若透视表工作表不存在则创建并生成透视表
            If pvtWs Is Nothing Then
                Set pvtWs = wb.Worksheets.Add(After:=wb.Worksheets(wb.Worksheets.Count))
                pvtWs.Name = pvtSheetName
                
                ' 创建透视缓存与透视表
                Set pvtCache = wb.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=dataRG)
                Set pvtTable = pvtCache.CreatePivotTable(TableDestination:=pvtWs.Cells(1, 1))
                pvtTable.Name = pvtSheetName
            End If
        End If
    Next srcSht
End Sub

方式2：手动指定源表与透视表名称数组 #

如果源工作表名称与透视表名称无固定规律，可通过数组一一对应：

Sub CreatePivotTablesWithArray()
    Dim wb As Workbook
    Dim srcShtNames() As Variant
    Dim pvtSheetNames() As Variant
    Dim srcSht As Worksheet
    Dim pvtWs As Worksheet
    Dim dataRG As Range
    Dim pvtCache As PivotCache
    Dim pvtTable As PivotTable
    Dim i As Integer
    
    Set wb = ActiveWorkbook
    ' 手动指定源工作表名称与对应透视表名称数组
    srcShtNames = Array("Test1", "Test2", "Test3", "Test4", "Test5", "Test6", "Test7")
    pvtSheetNames = Array("Test1 Pivot", "Test2 Pivot", "Test3 Pivot", "Test4 Pivot", "Test5 Pivot", "Test6 Pivot", "Test7 Pivot")
    
    For i = LBound(srcShtNames) To UBound(srcShtNames)
        Set srcSht = wb.Worksheets(srcShtNames(i))
        
        ' 检查透视表工作表是否已存在
        Set pvtWs = Nothing
        On Error Resume Next
        Set pvtWs = wb.Worksheets(pvtSheetNames(i))
        On Error GoTo 0
        
        ' 获取当前源工作表的数据区域
        Set dataRG = srcSht.Range("A4").CurrentRegion
        
        ' 创建新透视表工作表及透视表
        If pvtWs Is Nothing Then
            Set pvtWs = wb.Worksheets.Add(After:=wb.Worksheets(wb.Worksheets.Count))
            pvtWs.Name = pvtSheetNames(i)
            
            Set pvtCache = wb.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=dataRG)
            Set pvtTable = pvtCache.CreatePivotTable(TableDestination:=pvtWs.Cells(1, 1))
            pvtTable.Name = pvtSheetNames(i)
        End If
    Next i
End Sub

关键修正点 #

1. 将源表遍历与透视表创建合并，确保每次循环都使用当前源表的dataRG
2. 添加透视表工作表存在性检查，避免重复创建
3. 两种方式分别适配自动匹配/手动指定的名称对应场景

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