Macro to create a New File with a pivot table and source data table

[bearcub]

I have to create and prepare between 30 to 40 files from a data source to send to the some of our International Sales reps.

We are making a FX commission payment for our Europe organization based upon deals they closed since Feb 1st of this year.

Between creating the source files and sending out individual to each rep receiving payment is going to take at least a day for me to create the task without the aid of a macro.

I'm hoping to find a macro that can create and prepare a file for each rep with the payment details so it will reduce the amount of time it is going to take to complete this task.

I have the data for each rep in a table (the table is between 300-400 lines). Each line represents a payment each rep is to receive for an order they closed.

Is it possible to use the source data to create the following:

1) New File with the rep's name
2) The Person's name as the sheet name
3) Create a pivot table
4) Show the source data below the pivot table

I'm hoping I can find a macro that will help me prepare the files before I have to send out the emails to providing the payment detail for each one of the reps

Thank you for your help in advance

Here is a snapshot of the source data from the main file, the pivot table and the data source table in a new file

Source Data
Person Name	Commission	Currency	Rate	FX Credits	Customer Name	Order Item Code	Order Code	Incentive Date	Earning Group	Geography Name	Period
Alexandra Conroy	£132.40	GBP	3.72%	$3,561.04	Camelot UK Lotteries Limited	FY23 1H FX Adjustments	0063t0000117O5rAAE - Multi Year	8/31/22	Multi Year	Northern Europe	August
Alexandra Conroy	£357.13	GBP	3.72%	$9,605.44	Länsförsäkringar AB	FY23 1H FX Adjustments	0063t00000rouBtAAI - Multi Year	8/31/22	Multi Year	Northern Europe	August
Alexandra Conroy	£3,006.62	GBP	3.72%	$80,866.17	Sky UK Limited	FY23 1H FX Adjustments	0063t00000ymAsaAAE - Multi Year	8/31/22	Multi Year	Northern Europe	August
Alexandra Conroy	£493.99	GBP	10.29%	$4,802.72	Länsförsäkringar AB	FY23 1H FX Adjustments	0063t00000rouBtAAI - NARR	8/31/22	NARR	Northern Europe	August
Alexandra Conroy	£4,158.76	GBP	10.29%	$40,432.42	Sky UK Limited	FY23 1H FX Adjustments	0063t00000ymAsaAAE - NARR	8/31/22	NARR	Northern Europe	August
Alexandra Conroy	£37.38	GBP	0.74%	$5,027.34	Camelot UK Lotteries Limited	FY23 1H FX Adjustments	0063t0000117O5rAAE - Renewal	8/31/22	Renewal	Northern Europe	August
Macro to create the following results :
1) New File & Sheet with Person Name
2) Pivot Table and
3) Source Data Table:
2) Pivot Table from Source
Customer Name	Earning Group	Incentive Date	Order Code	FX Credits	Commissions
Camelot UK Lotteries Limited	Multi Year	8/31/2022	0063t0000117O5rAAE - Multi Year	3561.04	£132.40
	Renewal	8/31/2022	0063t0000117O5rAAE - Renewal	5027.34	£37.38
Länsförsäkringar AB	NARR	8/31/2022	0063t00000rouBtAAI - NARR	4802.72	£493.99
	Multi Year	8/31/2022	0063t00000rouBtAAI - Multi Year	9605.44	£357.13
Sky UK Limited	NARR	8/31/2022	0063t00000ymAsaAAE - NARR	40432.42	£4,158.76
	Multi Year	8/31/2022	0063t00000ymAsaAAE - Multi Year	80866.17	£3,006.62
Grand Total				144295.13	£8,186.30
3) Table
Person Name	Commission	Currency	Rate	FX Credits	Customer Name	Order Item Code	Order Code	Incentive Date	Earning Group	Geography Name	Period
Alexandra Conroy	£132.40	GBP	3.72%	$3,561.04	Camelot UK Lotteries Limited	FY23 1H FX Adjustments	0063t0000117O5rAAE - Multi Year	8/31/22	Multi Year	Northern Europe	August
Alexandra Conroy	£357.13	GBP	3.72%	$9,605.44	Länsförsäkringar AB	FY23 1H FX Adjustments	0063t00000rouBtAAI - Multi Year	8/31/22	Multi Year	Northern Europe	August
Alexandra Conroy	£3,006.62	GBP	3.72%	$80,866.17	Sky UK Limited	FY23 1H FX Adjustments	0063t00000ymAsaAAE - Multi Year	8/31/22	Multi Year	Northern Europe	August
Alexandra Conroy	£493.99	GBP	10.29%	$4,802.72	Länsförsäkringar AB	FY23 1H FX Adjustments	0063t00000rouBtAAI - NARR	8/31/22	NARR	Northern Europe	August
Alexandra Conroy	£4,158.76	GBP	10.29%	$40,432.42	Sky UK Limited	FY23 1H FX Adjustments	0063t00000ymAsaAAE - NARR	8/31/22	NARR	Northern Europe	August
Alexandra Conroy	£37.38	GBP	0.74%	$5,027.34	Camelot UK Lotteries Limited	FY23 1H FX Adjustments	0063t0000117O5rAAE - Renewal	8/31/22	Renewal	Northern Europe	August
Totals	8,186.30	-		144,295.13

 

[bearcub]

I ended up creating a pivot table and then filtered on the Person Name field. I then had to manual copy the pivot table (without the name field) to create a static table. I then created went through each sheet where I copied the data table below the pivot table from my original data table. I don't know if it is TMI but I wanted to make it look clean and professional for optics.

Now I have to spend the next few hours sending out the emails to the reps. I have to copy and paste a prewritten statement and then attach the files I just created.

We're probably going to be doing this once a quarter. Hopefully I can find a more efficient way to build all this going forward

I did have the following code from another situation I had earlier in the year:

Sub Save_All_Sheets_As_Workbooks()
Dim wb1 As Workbook, folder, i As Long
Set wb1 = ActiveWorkbook
On Error Resume Next

    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Please select a folder"
        .AllowMultiSelect = False
        .Show
        folder = .SelectedItems(1)
    End With
    If folder = False Then MsgBox "No folder selected.": Exit Sub
Application.ScreenUpdating = False
    For i = 1 To wb1.Sheets.Count
        If wb1.Sheets(i).Name <> "Master" Then
            wb1.Sheets(i).Copy
                Application.DisplayAlerts = False
                    With ActiveWorkbook
                        .SaveAs folder & "\" & wb1.Sheets(i).Name & ".xlsx", FileFormat:=51
                    .Close
                End With

 

[bearcub]

Forgot to include the last 2 lines of code

Sub Save_All_Sheets_As_Workbooks()
Dim wb1 As Workbook, folder, i As Long
Set wb1 = ActiveWorkbook
On Error Resume Next

    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Please select a folder"
        .AllowMultiSelect = False
        .Show
        folder = .SelectedItems(1)
    End With
    If folder = False Then MsgBox "No folder selected.": Exit Sub
Application.ScreenUpdating = False
    For i = 1 To wb1.Sheets.Count
        If wb1.Sheets(i).Name <> "Master" Then
            wb1.Sheets(i).Copy
                Application.DisplayAlerts = False
                    With ActiveWorkbook
                        .SaveAs folder & "\" & wb1.Sheets(i).Name & ".xlsx", FileFormat:=51
                    .Close
                End With
            Application.DisplayAlerts = True
        End If
    Next i
Application.ScreenUpdating = True
End Sub