Excel 循环遍历数据透视表，并使用字段名称将每个字段的详细信息保存在单独的工作簿中

我正在Excel中的一个项目中工作，在这个项目中，我有一个数据透视表，其中包含人员的姓名及其相关的声明。我需要双击表中的每个名称，当详细信息显示在单独的工作表中时，将该工作表保存为单独的工作簿，并将该人员的姓名保存在文件夹中。有没有办法在VBA中自动化此过程

下面的代码适用于第一项，但有几个问题：

-工作表和工作簿的名称是硬编码的，因此仅适用于第一项。是否只需选择新工作表而不按名称选择？有没有办法用项目名称代替Book3.xlsx

这是我的密码：

Sub IndividualReports()

Application.ScreenUpdating = False
On Error Resume Next

Dim LastRow As Long

Sheets("Table").Select

  With Application.ActiveSheet
      LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
  End With

For i = 8 To LastRow
  Range("C" & i).Select
  Selection.ShowDetail = True
  Sheets("Sheet2").Select
  Sheets("Sheet2").Move
  Sheets("Sheet2").Select
  ChDir "C:\Users\haghigy\Desktop\New3"
  ActiveWorkbook.SaveAs Filename:="C:\Users\haghigy\Desktop\New3\Book3.xlsx", _
      FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
Next

End Sub

谢谢你的帮助

*编辑：这是解决方案后的代码

Sub IndividualReports()

Dim LastRow As Long
Dim Name As String
Dim Path As String
Dim fldr As FileDialog

Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
    .Title = "Select a Folder"
    .AllowMultiSelect = False
    .InitialFileName = Application.DefaultFilePath
    If .Show <> -1 Then GoTo NextCode
    Path = .SelectedItems(1) & "\"
End With
NextCode:
    GetFolder = Path
    Set fldr = Nothing

Sheets("Table").Select
    With Application.ActiveSheet
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With

For i = 6 To LastRow - 1

Name = Application.WorksheetFunction.Index(Sheets("Table").Rang("A6:A200"), i - 5)
Range("C" & i).Select
Selection.ShowDetail = True
ActiveSheet.Move
ActiveWorkbook.SaveAs Filename:=Path & Name, _
    FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWorkbook.Close

Next
End Sub

---

好的开始！我注意到了几件事。首先也是最重要的一点是，当您将明细表移动到新工作簿并另存为时，包含透视表的工作簿不再是活动工作簿。因此，在新工作簿上选择范围将不起作用。你可以加上

Workbooks("[WorkbookName].xlsx").Activate
Sheets("Table").Activate

到你的循环的顶端。此外

Sheets("Sheet2").Select
Sheets("Sheet2").Move
Sheets("Sheet2").Select

这两种选择方法是不需要的，并且图纸编号将增加，因此它并不总是Sheet2。您可以将上面的块替换为：

ActiveSheet.Move

最后，您必须更改正在保存的工作簿的名称，这样它就不会每次都被覆盖。也许像：

filename:="C:\Users\haghigy\Desktop\New3\Book" & i & ".xlsx"

那么它应该会起作用

---

*编辑：也不需要ChDir

欢迎使用SO，请向我们展示您自己尝试过的内容？您可能想看一下，然后提问以添加更多信息。谢谢您的建议。我是VBA新手，所以我不确定是发布我所拥有的还是从头开始。我用我现在掌握的代码更新了我的问题，我认为最好从你目前掌握的代码开始。作为一种最佳实践，我建议至少在调试时不要让错误恢复到下一步并关闭屏幕更新。这些错误可以给你一个错误的线索，并且在代码F8中看到你在做什么是很有帮助的。太棒了！非常感谢你。我修改了我的代码，它工作得很好。