새 시트에 피벗 테이블 대신 새 시트 만 넣습니다.

Question

새 시트에 자동으로 피벗 테이블을 삽입하고 싶습니다. 이 작업을 실행하면 피벗 테이블 이름의 새 시트 만 삽입되지만 피벗 캐시는 만들지 않으며 소스 시트에서 데이터를 읽지 않습니다. 이 경우 시트 이름은 Data이고 Pivot이어야합니다.

Sub InsertPivotTable() 

    Dim PSheet As Worksheet 
    Dim DSheet As Worksheet 
    Dim PCache As PivotCache 
    Dim PTable As PivotTable 
    Dim PRange As Range 
    Dim LastRow As Long 
    Dim LastCol As Long 

    On Error Resume Next 
    Application.DisplayAlerts = False 
    Worksheets("PivotTable").Delete 
    Sheets.Add Before:=ActiveSheet 
    ActiveSheet.Name = "PivotTable" 
    Application.DisplayAlerts = True 

    Set PSheet = Worksheets("PivotTable") 
    Set DSheet = Worksheets("Data") 

    LastRow = DSheet.Cells(Rows.Count, 1).End(xlUp).Row 
    LastCol = DSheet.Cells(1, Columns.Count).End(xlToLeft).Column 

    Set PRange = DSheet.Cells(1, 1).Resize(LastRow, LastCol) 

    Set PCache = ActiveWorkbook.PivotCaches.Create _ 
     (SourceType:=xlDatabase, SourceData:=PRange). _ 
     CreatePivotTable(TableDestination:=PSheet.Cells(2, 2), _ 
     TableName:="PivotTable") 

    Set PTable = PCache.CreatePivotTable _ 
     (TableDestination:=PSheet.Cells(1, 1), TableName:="PivotTable") 

    With ActiveSheet.PivotTables("PivotTable").PivotFields("Last_Touch_User_Name") 
     .Orientation = xlRowField 
     .Position = 1 
    End With 

    With ActiveSheet.PivotTables("PivotTable").PivotFields("Action_Code") 
     .Orientation = xlColumnField 
     .Position = 1 
    End With 

    With ActiveSheet.PivotTables("PivotTable").PivotFields("Result_Code") 
     .Orientation = xlColumnField 
     .Position = 2 
    End With 

    With ActiveSheet.PivotTables("PivotTable").PivotFields("Medical_Manager__") 
     .Orientation = xlDataField 
     .Position = 1 
     .Function = xlCount 
    End With 

End Sub 

Answer 1

당신이 결합하거나 부분적으로 여기 단계를 분리하는 시도처럼 당신이 보는 : 사실 당신이 원하는 때

이

Set PCache = ActiveWorkbook.PivotCaches.Create _ 
     (SourceType:=xlDatabase, SourceData:=PRange). _ 
     CreatePivotTable(TableDestination:=PSheet.Cells(2, 2), _ 
     TableName:="PivotTable") 

Set PTable = PCache.CreatePivotTable _ 
    (TableDestination:=PSheet.Cells(1, 1), TableName:="PivotTable") 

(당신의 변수에 따라)의 생성을위한 두 개의 완전히 분리 단계를 가지고 캐시 다음 피벗 테이블 :

Set PCache = ActiveWorkbook.PivotCaches.Create(xlDatabase, SourceData:=PRange) 

Set PTable = PCache.CreatePivotTable _ 
     (TableDestination:=PSheet.Cells(1, 1), TableName:="PivotTable") 

그리고 아마도 이유는 요 인 On Error Goto O 폐쇄되지 On Error Resume Next 조심 u는 이것을 발견하지 못했다.

항상 철자 등의 변수 선언을 확인하기 위해 모듈의 상단에 Option Explicit를 추가