Проходите по сводной таблице и сохраняйте детали каждого поля в отдельной рабочей книге с именем поля

Question

Я работаю над проектом в 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

Answer 1

Отличное начало! Пара вещей, которые я заметил. Прежде всего, когда вы перемещаете лист сведений в новую книгу и сохраняете как, ваша книга с сводной таблицей больше не является активной книгой. Таким образом, выбор диапазона в новой книге не будет работать. Вы могли бы добавить

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

к вершине вашей петли. В дальнейшем,

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

Два метода Select не нужны, и номера листов будут увеличиваться, поэтому это не всегда будет Sheet2. Вы можете заменить блок выше на:

ActiveSheet.Move

Наконец, вам нужно изменить имя сохраняемой книги, чтобы она не просто перезаписывалась каждый раз. Может быть, как:

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

Тогда это должно работать.

* редактировать: также не нужен ChDir