将数据透视表添加到包含同一工作表中数据的新工作表

My code creates a new sheet as per below code which is ws2 where I have a table extracted from ws1. I want to place a pivot table on the same sheet ws2 in cell "L4" as per bottom part of the code, but it would not work.

我的代码根据下面的代码创建了一个新工作表，这是ws2，其中我有一个从ws1中提取的表。我想根据代码的底部部分在单元格“L4”中的相同工作表ws2上放置一个数据透视表，但它不起作用。

Sub ClickThisMacro()

Dim i As Long
Dim y As Long
Dim n As Long

Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets("Report")

Dim ws2 As Worksheet: Set ws2 = Sheets.Add

Set rng1 = ws1.Range("A:A").Find("Name")

fr = rng1.Row
lr = ws1.Range("B" & Rows.Count).End(xlUp).Row
y = 2

For i = fr + 1 To lr
    ws2.Cells(y, 1) = ws1.Cells(i, 1)
    ws2.Cells(y, 2) = ws1.Cells(i, 2)
    ws2.Cells(y, 3) = ws1.Cells(i, 3)
    ws2.Cells(y, 4) = ws1.Cells(i, 4)
    ws2.Cells(y, 5) = ws1.Cells(i, 18)

    y = y + 1
Next i

ws2.Cells(1, 1) = "Cost centre name"
ws2.Cells(1, 2) = "Cost centre code"
ws2.Cells(1, 3) = "Phone number"
ws2.Cells(1, 4) = "User name"
ws2.Cells(1, 5) = "Amount"

LastRow = ws2.Range("A1").End(xlDown).Row

' making columns C and F numbers
ws2.Range("C2:C" & LastRow).Select

For Each xCell In Selection
    xCell.Value = xCell.Value
Next xCell

With ws2.UsedRange.Columns(5)
    .Replace "£", "", xlPart
    .NumberFormat = "#,##0.00"
    .Formula = .Value
End With

With ws2.UsedRange.Columns(8)
    .Replace "£", "", xlPart
    .NumberFormat = "#,##0.00"
    .Formula = .Value
End With

'Pivot table
Dim mypivot As PivotTable
Dim mycache As PivotCache

Set mycache = ws2.PivotCaches.Create(xlDatabase, Range("a1").CurrentRegion)

Set mypivot = ws2.PivotTables.Add(mycache.Range("l4"), "Mypivot1")

mypivot.PivotFields("Cost centre name").Orientation = xlRowField
mypivot.PivotFields("Cost centre code").Orientation = xlColumnField
mypivot.PivotFields("Amount").Orientation = xlDataField

End Sub

1 个解决方案

#1

You have a few syntax errors in your code at the section where you set your PivotCache and PivotTable objects.

您在设置PivotCache和PivotTable对象的部分中的代码中存在一些语法错误。

Modified code (Pivot-Table section)

修改后的代码（Pivot-Table部分）

' set the Pivot-Cache
Set mycache = ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=ws2.Range("A1").CurrentRegion.Address(False, False, xlA1, xlExternal))

' set the Pivot-Table object
Set mypivot = ws2.PivotTables.Add(PivotCache:=mycache, TableDestination:=ws2.Range("L4"), TableName:="Mypivot1")

With mypivot
    .PivotFields("Cost centre name").Orientation = xlRowField
    .PivotFields("Cost centre code").Orientation = xlColumnField
    .PivotFields("Amount").Orientation = xlDataField
End With

Some Other modifications/suggestions you should add to your code:

您应该在代码中添加的其他一些修改/建议：

Using Find you should handle a scenario (even though unlikely) that you won't find the term you are looking for, in that case if Rng1 = Nothing then fr = Rng1.Row will result with a run-time error.
使用Find你应该处理一个场景（尽管不太可能），你找不到你要找的术语，在这种情况下如果Rng1 = Nothing则fr = Rng1.Row将导致运行时错误。

Dealing with Find code:

处理查找代码：

Set Rng1 = ws1.Range("A:A").Find("Name")
If Not Rng1 Is Nothing Then ' confirm Find was successfull
    fr = Rng1.Row
Else ' if Find fails
    MsgBox "Critical Error, couldn't find 'Name' in column A", vbCritical
    Exit Sub
End If

You should avoid using Select and Selection, you can use fully qualified Range object instead:
您应该避免使用Select和Selection，您可以使用完全限定的Range对象：

Looping through a Range:

循环范围：

For Each xCell In ws2.Range("C2:C" & lr)
    xCell.Value = xCell.Value
Next xCell

#1