如何用VBA从另一工作簿数据透视表自动填充Excel工作表？

问题背景 #

我现在有两个打开的Excel工作簿：

• 一个里面有这样的数据透视表：

  Row Labels  Date
  A           5
  B           4
  C           3
  

• 另一个工作簿只有A列是和透视表一致的Row Labels，但顺序打乱了：

  Row Labels
  B
  A
  C
  

我想在第二个工作簿加个按钮，点击后自动把透视表里对应的Date列填充到对应Row Label的位置，而且代码得能适配任意大小的透视表和任意数量的行标签。知道要用VLOOKUP，但不清楚具体怎么用VBA实现这个动态需求。

完整解决方案 #

第一步：给工作簿起个好记的名字 #

先确保两个工作簿都处于打开状态，右键点击底部工作表标签：

• 把带透视表的工作簿重命名为PivotSource.xlsx（名字可以随便改，后面代码对应上就行）
• 把需要填充数据的目标工作簿重命名为TargetData.xlsx

第二步：给目标工作簿添加按钮并关联宏 #

1. 打开TargetData.xlsx，找到「开发工具」选项卡（如果没显示，去「文件→选项→自定义功能区」勾选出来）
2. 点击「插入」，选择「表单控件」里的按钮（窗体控件），在工作表合适位置拖拽画出按钮
3. 弹出「指定宏」对话框，点击「新建」，此时VBA编辑器会自动打开并生成一个空的宏模板

第三步：编写动态适配的VBA代码 #

把编辑器里的空宏替换成以下代码：

Sub FillDataFromPivot()
    Dim pivotWB As Workbook
    Dim targetWB As Workbook
    Dim pivotSheet As Worksheet
    Dim targetSheet As Worksheet
    Dim pivotDataRange As Range
    Dim targetRowLabelsRange As Range
    Dim lastPivotRow As Long
    Dim lastTargetRow As Long
    Dim fillColumn As Integer
    
    ' 关联工作簿和工作表——这里的名字要和你刚才修改的对应上
    Set pivotWB = Workbooks("PivotSource.xlsx")
    Set targetWB = ThisWorkbook ' 当前按钮所在的工作簿
    Set pivotSheet = pivotWB.Sheets(1) ' 假设透视表在第一个工作表，不在的话改数字
    Set targetSheet = targetWB.Sheets(1) ' 目标数据在第一个工作表，同理可调整
    
    ' 自动识别透视表的最后一行，不用手动数行数
    lastPivotRow = pivotSheet.Cells(pivotSheet.Rows.Count, "A").End(xlUp).Row
    ' 假设透视表Row Labels在A列，对应值在B列，列变动的话修改这里的范围
    Set pivotDataRange = pivotSheet.Range("A1:B" & lastPivotRow)
    
    ' 自动识别目标工作簿Row Labels的最后一行
    lastTargetRow = targetSheet.Cells(targetSheet.Rows.Count, "A").End(xlUp).Row
    ' 假设目标Row Labels表头在A1，数据从A2开始，表头位置变了就改起始行
    Set targetRowLabelsRange = targetSheet.Range("A2:A" & lastTargetRow)
    
    ' 设置要填充数据的列——这里是B列，想填到C列就改成3
    fillColumn = 2
    
    ' 写入动态VLOOKUP公式，自动拼接跨工作簿引用路径
    targetSheet.Cells(2, fillColumn).Formula = _
        "=VLOOKUP(A2, '" & pivotWB.Path & "\[" & pivotWB.Name & "]" & pivotSheet.Name & "'!" & pivotDataRange.Address & ", 2, FALSE)"
    ' 批量填充公式到所有行，比逐行循环高效得多
    targetSheet.Range(targetSheet.Cells(2, fillColumn), targetSheet.Cells(lastTargetRow, fillColumn)).FillDown
    
    ' 可选操作：把公式转为静态值，这样关闭源工作簿后数据也不会失效
    ' 要是想保留公式随时更新，就把下面两行注释掉
    targetSheet.Range(targetSheet.Cells(2, fillColumn), targetSheet.Cells(lastTargetRow, fillColumn)).Value = _
        targetSheet.Range(targetSheet.Cells(2, fillColumn), targetSheet.Cells(lastTargetRow, fillColumn)).Value
End Sub

第四步：测试功能 #

回到TargetData.xlsx，点击刚创建的按钮，检查填充列（比如B列）：B行显示4，A行显示5，C行显示3，完全匹配目标工作簿的Row Labels顺序就成功了！

关键细节说明 #

• 动态适配：用End(xlUp)自动定位最后一行，不管透视表有10行还是1000行，都能自动识别，无需手动修改代码
• 跨工作簿引用：代码自动拼接源工作簿的路径和名称，只要两个工作簿都打开，就算移动文件夹也不会出错
• 高效填充：用FillDown批量应用公式，比逐行循环写公式效率高很多，大数据量时优势明显
• 灵活调整：如果透视表的对应值在C列，就把pivotDataRange改成"A1:C" & lastPivotRow，同时VLOOKUP第三个参数改成3；想把数据填充到其他列，修改fillColumn的数字即可

内容的提问来源于stack exchange，提问作者Python learner 93