在for循环中创建数据透视表vba

Question

我有一个包含70张工作表的工作簿。每个工作表都被创建并命名，并使用过滤器将相应的数据放入工作表中。数据范围有可能逐周改变。我写了一个vba程序来完成所有工作，但是使用独特的过滤数据在每个工作表中创建数据透视表。 我的问题是，如何在for循环中的每个工作表中创建一个数据透视表？我已经扣除了我的代码中的问题是代码中的源数据部分。每个选项卡的数据范围将不同（列保持不变，但行数不同）。 我是否还需要在循环内迭代时重命名透视表？

Sub Ptloop() 

dim x as long 
dim SorceRange as Range 
dim k as long 
'start of first generated work sheet 
x=4 
'number of worksheets 
k=75 


Set SourceRange = Range("A4", ActiveCell.End(xlDown).End(xlToRight)) 

For Each Worksheet In ActiveWorkbook.Sheets 
If x <= k Then 

ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _ 
    Sheets(x).SourceRange, Version:=xlPivotTableVersion14). _ 
    CreatePivotTable TableDestination:=Sheets(x).Cells(4, 21), TableName:="PivotTable3", DefaultVersion _ 
    :=xlPivotTableVersion14 
x = x + 1 
Else 
Exit For 
End If 
Next Worksheet 
End Sub 

Answer 1

有可能被关闭抛出代码几件事情，或者有潜力了。

请参阅下面的重构代码，以获得更清洁，更易于维护的程序。

Option Explicit 'this forces variable declaration and is a "must use" programming tool 

Sub Ptloop() 

Dim ws as Worksheet 'make sure to qualify the worksheet to a variable 
         'using `Worksheet` could be problematic since its a reserved word in Excel for the `Worksheet` object itself 

Dim SourceRange as Range 

For Each ws In ThisWorkbook.Worksheets 'if you have a chart or macro sheet in your workbook `Sheets` will produce an error, if you only need actual Worksheets, use that directly 

    If ws.Index > 3 Then 'use the index property, you only want worksheets after sheet 3 

     With ws 'work directly with the object and assignment parentage to all objects 

      'set the range inside the loop to capture the data for that specific sheet 
      Set SourceRange = .Range("A4", .Range("A4").End(xlDown).End(xlToRight)) 

      'ActiveWorkbook may or may not refer to the workbook you really want to work with .. ThisWorkbook refers to the book running the code 
      ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=SourceRange, Version:=xlPivotTableVersion14). _ 
       CreatePivotTable TableDestination:=.Cells(4, 21), TableName:="PivotTable" & ws.Index, DefaultVersion _ 
       :=xlPivotTableVersion14 

     End With 

    End If 

Next ws 

End Sub