VBA - Copy information to new workbook - excel

Question

I'm trying to do something that sounds incredibly simple but I can't figure out how to fit it into existing VBA code. The code below cycles through a pivot table 1 item at a time and copies that pivot table data out to a new workbook and emails to the staff member
All i need to add in is for it to copy (just values and formatting) a 13x2 table in the range E15:S16 on the same sheet as the pivot table, into the new workbook in the tab I've named "Monthly Forecast". with the loops etc i'm not sure how to get this into the code so it copies the pivot data and then the monthly forecast into the separate tab
Hope that makes sense, any help would be wonderful :)
Option Explicit
Sub PivotSurvItems()
Dim i As Integer
Dim sItem As String
Dim sName As String
Dim sEmail As String
Dim OutApp As Object
Dim OutMail As Object
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
With ActiveSheet.PivotTables("PivotTable1")
.PivotCache.MissingItemsLimit = xlMissingItemsNone
With .PivotFields("Staff")
'---hide all items except item 1
.PivotItems(1).Visible = True
For i = 2 To .PivotItems.Count
.PivotItems(i).Visible = False
Next
For i = 1 To .PivotItems.Count
.PivotItems(i).Visible = True
If i <> 1 Then .PivotItems(i - 1).Visible = False
sItem = .PivotItems(i)
ActiveSheet.PivotTables("PivotTable1").PivotSelect "", xlDataAndLabel, True
Selection.Copy
Workbooks.Add
With ActiveWorkbook
.Sheets(1).Cells(1).PasteSpecial _
Paste:=xlPasteValuesAndNumberFormats
Worksheets("Sheet1").Columns("A:R").AutoFit
ActiveSheet.Range("A2").AutoFilter
sName = Range("C" & 2)
sEmail = Range("N" & 2)
Columns(1).EntireColumn.Delete
Columns(2).EntireColumn.Delete
Columns(2).EntireColumn.Delete
Columns(2).EntireColumn.Delete
Columns(10).EntireColumn.Delete
ActiveSheet.Name = "FCW"
Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Monthly Forecast"
Worksheets("FCW").Activate
'create folder
On Error Resume Next
MkDir "C:\Temp\FCW" & "\" & sName
On Error GoTo 0
.SaveAs "C:\Temp\FCW" & "\" & sName & "\" & sItem & " " & Format(Now(), "DD-MM-YYYY") & ".xlsx", _
FileFormat:=xlOpenXMLWorkbook
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = sEmail
.CC = ""
.BCC = ""
.Subject = "Planning Spreadsheet"
.Attachments.Add ActiveWorkbook.FullName
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
.Close
End With
Next i
End With
End With
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
End Sub

Answer 1

Instead of changing visibility and cycling through all the items in the pivot table, assign the values to a 'table' (a range) and pass it to where you want it to go (it's much faster than using Excel's .copy and .PasteSpecial in VBA.
Also, I suggest that you copy all the data to an 'outputs' worksheet in the same workbook. When all the data has been copied, export that specific outputs worksheet into a new workbook. This way you avoid copying and pasting data between two different workbooks which can be prone to errors.
In your code, I would remove everything from the item cycling down until the Temp folder creation and replace it with something like the following:
'Copy values
Set rStartCell = ActiveSheet.Range("A1") 'Specify the top-left corner cell of the data you wish to copy
Set rTable_1 = ActiveSheet.Range(rStartCell, ActiveSheet.Range("Z" & rStartCell.End(xlDown).Row)) 'Change the Z column to the last column of the data you wish to copy. You can automate this by using something like Range(A1).end(xltoright).columns.count formula to grab the number of columns.
Debug.Print "rTable_1: " & rTable_1.Address & " -> " & rTable_1.Rows.Count & " x " & rTable_1.Columns.Count 'good to test exactly what you're copying
'Paste Values
Set rStartCell = Outputs.Range("A1") 'Change A1 to the cell of where you want to paste on the Outputs worksheet in your original workbook.
Set rTable_2 = Outputs.Range(rStartCell, rStartCell.Offset(rTable_1.Rows.Count - 1, rTable_1.Columns.Count - 1))
Debug.Print "rTable_2: " & rTable_2.Address & " -> " & rTable_2.Rows.Count & " x " & rTable_2.Columns.Count
rTable_2.Value = rTable_1.Value
rTable_1.Copy
rTable_2.PasteSpecial Paste:=xlPasteFormats 'to copy/paste those formats you need
'Copy Worksheet and open it in a new workbook
ThisWorkbook.Sheets("NAME OF OUTPUTS SHEET").Copy 'Using ThisWorkbook to point to the workbook holding this code.
ActiveSheet.Name = "FCW"
You can use this method to copy/paste that other table mentioned as well.