编写可适配任意文件名的数据透视表VBA宏

下面是修改后的宏代码，解决了原代码依赖固定工作表名的问题，同时优化了代码结构，减少对Select的依赖，提升稳定性和通用性：

Sub Pivot()
    Dim dataSheet As Worksheet
    Dim pivotSheet As Worksheet
    Dim lastRow As Long
    Dim lastCol As Long
    Dim dataRange As Range
    Dim pivotCache As PivotCache
    Dim pivotTable As PivotTable
    
    ' 设置当前数据所在工作表（默认使用当前激活的工作表）
    Set dataSheet = ActiveSheet
    
    ' 插入Full Name列并设置格式
    dataSheet.Columns("M:M").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    dataSheet.Columns("L:L").ColumnWidth = 16.57
    dataSheet.Columns("M:M").ColumnWidth = 24.57
    dataSheet.Range("M1").Value = "Full Name"
    
    ' 写入全名公式并自动填充到末行
    lastRow = dataSheet.Cells.Find(What:="*", After:=dataSheet.Range("A1"), _
                                  SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    dataSheet.Range("M2").FormulaR1C1 = "=RC[-1]&"", ""&RC[-2]"
    dataSheet.Range("M2:M" & lastRow).FillDown
    
    ' 获取完整数据区域（动态适配列数）
    lastCol = dataSheet.Cells(1, dataSheet.Columns.Count).End(xlToLeft).Column
    Set dataRange = dataSheet.Range(dataSheet.Cells(1, 1), dataSheet.Cells(lastRow, lastCol))
    
    ' 创建新工作表用于存放透视表（避免重名）
    On Error Resume Next
    Set pivotSheet = ThisWorkbook.Sheets("PivotTableSheet")
    If Err.Number <> 0 Then
        Set pivotSheet = ThisWorkbook.Sheets.Add(After:=dataSheet)
        pivotSheet.Name = "PivotTableSheet"
    End If
    On Error GoTo 0
    
    ' 创建数据透视缓存和透视表
    Set pivotCache = ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=dataRange)
    Set pivotTable = pivotCache.CreatePivotTable(TableDestination:=pivotSheet.Range("A3"), _
                                                 TableName:="PivotTable1")
    
    ' 配置透视表属性
    With pivotTable
        .ColumnGrand = True
        .HasAutoFormat = True
        .DisplayErrorString = False
        .DisplayNullString = True
        .EnableDrilldown = True
        .ErrorString = ""
        .MergeLabels = False
        .NullString = ""
        .PageFieldOrder = 2
        .PageFieldWrapCount = 0
        .PreserveFormatting = True
        .RowGrand = True
        .SaveData = True
        .PrintTitles = False
        .RepeatItemsOnEachPrintedPage = True
        .TotalsAnnotation = False
        .CompactRowIndent = 1
        .InGridDropZones = False
        .DisplayFieldCaptions = True
        .DisplayMemberPropertyTooltips = False
        .DisplayContextTooltips = True
        .ShowDrillIndicators = True
        .PrintDrillIndicators = False
        .AllowMultipleFilters = False
        .SortUsingCustomLists = True
        .FieldListSortAscending = False
        .ShowValuesRow = False
        .CalculatedMembersInFilters = False
        .RowAxisLayout xlCompactRow
        .RepeatAllLabels xlRepeatLabels
    End With
    
    ' 设置透视表字段
    With pivotTable.PivotFields("Full Name")
        .Orientation = xlRowField
        .Position = 1
    End With
    pivotTable.AddDataField pivotTable.PivotFields("Pay Total"), "Sum of Pay Total", xlSum
    pivotTable.AddDataField pivotTable.PivotFields("Bill Total"), "Sum of Bill Total", xlSum
    
    ' 定位到透视表区域
    pivotSheet.Range("A3").Select
End Sub

关键修改说明： #

• 动态引用数据工作表：用dataSheet对象替代固定的"American Trans"工作表，默认使用当前激活的工作表，适配任意文件名的报表。
• 移除冗余的Select操作：直接通过工作表对象操作单元格和列，避免依赖Excel的激活状态，减少运行错误。
• 动态获取数据范围：自动识别数据的最后一行和最后一列，替代原代码中硬编码的R1C1:R1048576C31，适配不同列数的报表。
• 避免新建工作表重名：先检查是否存在名为"PivotTableSheet"的工作表，不存在再新建，防止重复创建报错。
• 优化公式填充：用FillDown替代AutoFill，代码更简洁高效。

内容的提问来源于stack exchange，提问作者anneeh