2017-08-18 3 views
1

ピボットテーブルを貼り付けようとすると、次のコードがハングアップします。以前はまったく同じコードを使用しましたが、ここでは機能しません。私は問題を見つけるためにそれを段階的に実行しました。以下は、コードの最後に太字の問題があるコード全体です。私は誰かが問題を上に見ることができる場合に備えてコード全体を追加しました。これは最後に貼り付けまでスムーズに実行されるので疑問です。Excel VBA自体をピボットテーブルに貼り付けるときにハングする

'Create Pivot Store Stock Issues 

Dim RowCount As Long 
Dim wsIssues As Worksheet 
Dim pc As PivotCache 
Dim pt As PivotTable 
Dim pi As PivotItem 
Dim pf As PivotField 
Dim lastRow As Long 

Set wsIssues = Worksheets.Add 
    RowCount = Worksheets("Summary").Cells(51, 1).End(xlDown).Row 
Set pc = ActiveWorkbook.PivotCaches.Create(xlDatabase, "Summary!R51C1:R" & RowCount & "C38") 
Set pt = pc.CreatePivotTable(wsIssues.Range("A3")) 

    'Speeds up code dramatically 
    pt.ManualUpdate = True 

    With pt.PivotFields("Site") 
     .Orientation = xlRowField 
     .Position = 1 
     .Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False) 
    End With 
    With pt.PivotFields("Name") 
     .Orientation = xlRowField 
     .Position = 2 
     .Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False) 
    End With 
    With pt.PivotFields("Ownership") 
     .Orientation = xlRowField 
     .Position = 3 
     .Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False) 
    End With 
    With pt.PivotFields("Article") 
     .Orientation = xlRowField 
     .Position = 4 
     .Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False) 
    End With 
    With pt.PivotFields("Article Description") 
     .Orientation = xlRowField 
     .Position = 5 
     .Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False) 
    End With 
    With pt.PivotFields("Promo") 
     .Orientation = xlRowField 
     .Position = 6 
     .Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False) 
     .PivotItems("(blank)").Caption = " " 
    End With 
    With pt.PivotFields("Vendor") 
     .Orientation = xlRowField 
     .Position = 7 
     .Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False) 
    End With 
    With pt.PivotFields("Pack Size") 
     .Orientation = xlRowField 
     .Position = 8 
     .Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False) 
    End With 

    wsIssues.PivotTables(1).Name = "StockIssues" 

    With pt.PivotFields("MS") 
     .Orientation = xlRowField 
     .Position = 9 
     .Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False) 
     .PivotFilters.Add Type:=xlCaptionEquals, Value1:="4" 
    End With 
    With pt.PivotFields("Listing Status") 
     .Orientation = xlRowField 
     .Position = 10 
     .Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False) 
     .PivotFilters.Add Type:=xlCaptionEquals, Value1:="Listed" 
    End With 
    With pt.PivotFields("RP Type") 
     .Orientation = xlRowField 
     .Position = 11 
     .Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False) 
     .PivotFilters.Add Type:=xlCaptionEquals, Value1:="Roster" 
    End With 

    With pt.PivotFields("OOS NO SOO") 
     .Orientation = xlRowField 
     .Position = 12 
     .Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False) 
    End With 
    With pt.PivotFields("OOS SOO") 
     .Orientation = xlRowField 
     .Position = 13 
     .Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False) 
    End With 
    With pt.PivotFields("SOH NO SOO") 
     .Orientation = xlRowField 
     .Position = 14 
     .Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False) 
    End With 
    With pt.PivotFields("Negative Stock") 
     .Orientation = xlRowField 
     .Position = 15 
     .Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False) 
    End With 
    With pt.PivotFields("Overstock") 
     .Orientation = xlRowField 
     .Position = 16 
     .Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False) 
    End With 
    With pt.PivotFields("Dormant Stock") 
     .Orientation = xlRowField 
     .Position = 17 
     .Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False) 
    End With 
    With pt.PivotFields("Outdated Stock Counts") 
     .Orientation = xlRowField 
     .Position = 18 
     .Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False) 
    End With 
    With pt.PivotFields("Total Issues") 
     .Orientation = xlRowField 
     .Position = 19 
     .Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False) 
    End With 

    With pt 
     .ShowDrillIndicators = False 
     .InGridDropZones = True 
     .RowAxisLayout xlTabularRow 
    End With 

    pt.RepeatAllLabels xlRepeatLabels 

    With pt 
     .ColumnGrand = False 
     .RowGrand = False 
    End With 

    pt.ManualUpdate = False 

    With wsIssues.PivotTables("StockIssues").TableRange2 
     .Copy 
     **.PasteSpecial Paste:=xlPasteValues** 
    End With 

    Application.Wait (Now + TimeValue("0:00:02")) 
+0

を同じコピー/ペーストアプローチが私のために正常に動作しますこと:多分ちょうどコピーする前にDoEvents関数を追加してみてください、ピボットテーブルが完全であることを確認します。 –

+0

は、 'Array(False、False、False .....' – jsotola

答えて

0

私は若干の修正を使用してコードを実行してきた、それがうまく働いた:

' already defined and set the pt object, why not use it 
pt.TableRange2.Copy '<-- copy the TableRange2 of the Pivot-Table 

' paste to range "A3" 
wsIssues.Range("A3").PasteSpecial xlPasteValues 
関連する問題