Циклический просмотр кода VBA в сводной таблице

Question

я загружаю отчет / запрос с моего рабочего сайта, поскольку он не позволяет мне сохранить его, поэтому я должен сделать это вручную. Я сохраняю файл и затем сначала открываю его

Затем он открывает шаблон my excel, копирует данные из листа макроса в этот шаблон, так как он скрывает и фильтрует многие вещи.

Затем я копирую и вставляю загруженный отчет в свой лист макроданных. Есть несколько просмотров в столбцах после данных.

Затем сначала фильтруется сводная таблица по каждому агентству - это для всех агентств. Как показано на рисунке, у меня есть еще 3, которые я делаю отдельно. 2 - агентством, а затем идентификатором подразделения, а другое - по имени поставщика. Я пытался сделать это на одной сводной таблице, но это стало беспорядком (дополнительные очки, если вы можете показать мне, как это кодировать).

Именно в этом и заключается проблема - при фильтрации она не будет ничего подбирать и более 20 раз сохранять пустой файл, пока не обнаружит что-то другое, а затем начнет разделять каждое агентство в папке (я поместил фильтр, чтобы избежать пробелов, который немного помог). но это все еще продолжает поднимать на тех же самых вещах не раз. что я могу сделать, чтобы узнать только то, что есть в сводной таблице?

Мне нужно добавить свой код электронной почты для автоматической отправки каждого листа по электронной почте, но при этом сохраняется более 20 пустых сообщений. Я должен удалять электронные письма, пока не достигну нужных. Вторая проблема, когда я фильтрую для каждого идентификатора устройства, он сохраняет файл со всеми идентификаторами устройств, а затем запускается и на последнем. Он повторяет последний более 20 раз. это не остановится, если я не остановлю это. Я не знаю, что является последним элементом, поэтому я прекращаю его, надеясь, что мне не придется запускать его снова, чтобы собрать больше данных.

Тогда он сохраняет каждого отдельно. (Дополнительный дополнительный бонусный балл - вы говорите мне, как он создаст папку с текущей датой и сохранит каждую в этой папке. Я попытался, и она сохранится на моем резервном диске. Его нужно сохранить на общем диске.

Извините, это очень много - я хотел быть тщательным, чтобы ничего не было упущено или неправильно понято. Раньше у меня было 2-3 часа на эти сообщения. Я сократил это до запуска этих отчетов за 10 минут - электронная почта была бы хороша, если бы я мог заставить ее перестать собирать одни и те же данные повторно.

   Sub PivotTable2()
    Dim src As Workbook
    Set src = Workbooks.Open("V:\existingsavedfilefromquery", True, True)
    ThisWorkbook.Activate
    Workbooks.Add Template:= _
    "V:\opensatemplatethatgetscopiedto\EINV_NEED_OK_TO_PAY_V7 - TEMPLATE.xltx"
    Windows("EINV_NEED_OK_TO_PAY_V7.xlsx").Activate 'selects all data in the macro book as there is vloopkups in the column after,
        Range("A3:AG3").Select
         Range(Selection, Selection.End(xlDown)).Select
        Range(Selection, Selection.End(xlToRight)).Select
        Selection.Copy
        Windows("EINV_NEED_OK_TO_PAY_V7 - Testing Macro1").Activate
        Sheets("Query_Data").Select
        Range("A2").Select
        ActiveSheet.Paste
        Sheets("Pivot Table").Select
        Range("A1").Select
        Application.CutCopyMode = False
        ActiveWorkbook.RefreshAll


    Dim pt As PivotTable, pi As PivotItem, pf As PivotField
    Dim lLoop As Long


    Set pt = Sheets("Pivot Table").PivotTables(1)
    Set pf = pt.PageFields(1) 
    With ActiveSheet.PivotTables(1).PivotFields("Supplier2")
    .PivotItems("(blank)").Visible = False
     End With    

    For Each pi In pf.PivotItems
    On Error Resume Next
        pt = Sheets("Pivot Table").Select
        pf.CurrentPage = pi.Value
    On Error GoTo 0

        Range("A6").Select
        Selection.ShowDetail = True
        Range("A2").CurrentRegion.Select *'this data changes all the time could be one line to 100 or so. it allows to only pick up the one line or it takes 1500000 line and save file take 30 minutes to save.*
        Selection.Copy
        Windows("EINV_NEED_OK_TO_PAY_V7 - TEMPLATE1").Activate
        Range("A2").Select
        Range("A2").Select
        ActiveSheet.Paste
        Application.CutCopyMode = False
        ActiveSheet.AutoFilter.ApplyFilter
        Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).EntireRow.Delete

    Dim Path As String
    Dim FileName1 As String


        Path = "V:\pathto shared drive\"
        FileName1 = Range("A2")
        ActiveWorkbook.SaveAs FileName:=Path & FileName1 & " " & "EINV_NEED_OK_TO_PAY_V7 - " & Format(Date, "MM-DD-YYYY") & ".xlsx" _
            , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False


      ActiveWindow.Close
        Workbooks.Add Template:= _
            "V:\opensatemplatethatgetscopiedto\EINV_NEED_OK_TO_PAY_V7 - TEMPLATE.xltx"

    Windows("EINV_NEED_OK_TO_PAY_V7 - Testing Macro1").Activate
    Sheets("Pivot Table").Select

     ILoop = ILoop + 1

      Next pi

    Windows("EINV_NEED_OK_TO_PAY_V7.xlsx").Close
    Windows("EINV_NEED_OK_TO_PAY_V7 - TEMPLATE1").Close

    End Sub