循环插入数据透视表问题

apple_orange

表格里有4个sheet，分别命名为"1" "2" "3" "4"，需要对表格进行数据插入操作，四个sheet进行同样的数据插入操作。要求代码先对名为"1"的sheet插入透视表操作，然后是"2" "3" "4"，代码运行时始终在名为"1"的sheet里运行，直至出错。代码如下，请高手帮忙看看是那里出了问题？
Sub TEST11()
'
' TEST Macro
'
'
    Dim WSD As Worksheet
    Dim PTCache As PivotCache
    Dim PT As PivotTable
    Dim PRange As Range
    Dim FinalRow As Long
    Dim FinalCol As Long
    Dim I As Integer
    Dim S As String
   
    For Each WSD In Worksheets '在表格内循环所有sheet
   
    '匹配sheet名字
    For I = 2 To 7
    S = CStr(I)
    If WSD.Name = "S" Then
    Set WSD = Worksheets("S")
    End If
    Next
   
   
    Range("AQ:CA").EntireColumn.Clear '清除其他数据透视表
        
    ' 定义输入数据以及数据源
    FinalRow = WSD.Cells(Application.Rows.Count, 1).End(xlUp).Row
    FinalCol = WSD.Cells(1, Application.Columns.Count).End(xlToLeft).Column
    Set PRange = WSD.Cells(1, 1).Resize(FinalRow, FinalCol)
    Set PTCache = ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:=PRange.Address)
        
    ' 创建数据透视表
    Set PT = PTCache.CreatePivotTable(TableDestination:=WSD.Cells(2, FinalCol + 6))
   
    With PT.PivotFields("PLINE")
        .Orientation = xlColumnField
        .Position = 1 'PLINE作为列标签放在第一列
    End With
    With PT.PivotFields("PMODLE")
        .Orientation = xlDataField
        .Function = xlCount
        .Position = 1
        .NumberFormat = "#,##0"
      
    End With
    With PT.PivotFields("是否过保")
        .Orientation = xlRowField
        .Position = 1 '是否过保作为行标签，放在第一行
        .PivotItems("否").Visible = False
        .PivotItems("#NUM!").Visible = False
        .PivotItems("#VALUE!").Visible = False
    End With
    With PT.PivotFields("PTYPE")
        .Orientation = xlRowField
        .Position = 2
    End With
    With PT.PivotFields("PMODLE")
        .Orientation = xlRowField
        .Position = 3
    End With
    Range("BA2").Select '选择起始坐标；
   
    Next
End Sub

hoogle

你上传附件，要不然没办法调试。

E-H-P

--------这能行吗-------------
For I = 2 To 7
    S = CStr(I)
    If WSD.Name = "S" Then
    Set WSD = Worksheets("S")
    End If
    Next
----------------是不是想这样-------------------
For I = 2 To 7
    S = CStr(I)
    If WSD.Name = S Then
    Set WSD = Worksheets(S)
    End If
    Next

apple_orange

重新修改了一下，去掉了Range("AQ:CA").EntireColumn.Clear 这句，貌似可以跑出想要的结果，但是加上这句一跑就出问题。请高手看下！
附上表格的附件，附件在后面。
Sub TEST111()
'
' TEST Macro
'

'
    Dim WSD As Worksheet
    Dim PTCache As PivotCache
    Dim PT As PivotTable
    Dim PRange As Range
    Dim FinalRow As Long
    Dim FinalCol As Long
    Dim I As Integer
    Dim S As String
   
    For Each WSD In Worksheets '在表格内循环所有sheet
   
    '匹配sheet名字
    For I = 1 To 7
    S = CStr(I)
    If WSD.Name = "S" Then
    Set WSD = Worksheets("S")
    End If
    Next
   
   
    ' 定义输入数据以及数据源
    FinalRow = WSD.Cells(Application.Rows.Count, 1).End(xlUp).Row
    FinalCol = WSD.Cells(1, Application.Columns.Count).End(xlToLeft).Column
    Set PRange = WSD.Cells(1, 1).Resize(FinalRow, FinalCol)
    Set PTCache = ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:=PRange.Address)
        
    ' 创建数据透视表
    Set PT = PTCache.CreatePivotTable(TableDestination:=WSD.Cells(2, FinalCol + 6))
   
    With PT.PivotFields("PLINE")
        .Orientation = xlColumnField
        .Position = 1 'PLINE作为列标签放在第一列
    End With
    With PT.PivotFields("PMODLE")
        .Orientation = xlDataField
        .Function = xlCount
        .Position = 1
        .NumberFormat = "#,##0"
      
    End With
    With PT.PivotFields("是否过保")
        .Orientation = xlRowField
        .Position = 1 '是否过保作为行标签，放在第一行
        .PivotItems("否").Visible = False
        .PivotItems("#NUM!").Visible = False
        .PivotItems("#VALUE!").Visible = False
    End With
    With PT.PivotFields("PTYPE")
        .Orientation = xlRowField
        .Position = 2
    End With
    With PT.PivotFields("PMODLE")
        .Orientation = xlRowField
        .Position = 3
    End With
    Range("H2").Select '选择起始坐标；
   
    Next

End Sub

apple_orange

此工作表里面4个sheet，每个sheet提取100条作为样本。

apple_orange

自己顶一下，请坛子里的高手帮忙看看呀！

无聊的疯子

apple_orange 发表于 2012-12-24 20:45
此工作表里面4个sheet，每个sheet提取100条作为样本。

透视表已经插入到 每个表的 h2  单元格了
透视表的名称是 透视表& 工作表名称

1. 
   
2. Sub cc()
   
3. Dim Sh As Worksheet
   
4.   For Each Sh In Worksheets
   
5.      ActiveWorkbook.PivotCaches.Create(1, Sh.Range("A:E"), 1).CreatePivotTable Sh.Range("H2"), "透视表" & Sh.Name, , 1
   
6.   Next
   
7. End Sub
   

复制代码

要显示什么样的数据，你自己拖几下拉几下就对了

apple_orange

试一试，这个貌似更简单呀！