Sub SendwithChart()
Application.ScreenUpdating = True
Application.DisplayAlerts = False
Sheets("Data").Select
ActiveSheet.Cells(1, 1).Select
ActiveCell.CurrentRegion.Select
srcdata = ActiveCell.CurrentRegion.Address
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
srcdata).CreatePivotTable TableDestination:="", _
TableName:="PivotTable1", DefaultVersion:=xlPivotTableVersion10
ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
ActiveSheet.Cells(3, 1).Select
ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
"PivotTable1").PivotFields("name"), "Count of name", xlCount
With ActiveSheet.PivotTables("PivotTable1").PivotFields("name")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable1")
.ColumnGrand = False
.RowGrand = False
End With
ActiveSheet.Name = "Pivot"
Sheets("Pivot").Select
Range("B5").Select
Do While ActiveCell.Value <> ""
Selection.ShowDetail = True
ActiveSheet.Name = Range("C2").Value
Range("B:B,F:F").Select
ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlLineMarkersStacked
ActiveChart.ApplyLayout (9)
Range("B:B,G:G,I:I,K:K").Select
ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlColumnClustered
ActiveChart.ApplyLayout (1)
ActiveChart.ChartTitle.Text = "Sold"
Range("B:B,H:H,J:J,L:L").Select
ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlColumnClustered
ActiveChart.ApplyLayout (1)
ActiveChart.ChartTitle.Text = "Revenue"
Set mailApp = CreateObject("Outlook.Application")
Set mail = mailApp.CreateItem(olMailItem)
mail.display
Set wEditor = mailApp.ActiveInspector.wordEditor
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveChart.ChartArea.Copy
wEditor.Application.Selection.Paste
ActiveSheet.ChartObjects("Chart 2").Activate
ActiveChart.ChartArea.Copy
wEditor.Application.Selection.Paste
ActiveSheet.ChartObjects("Chart 3").Activate
ActiveChart.ChartArea.Copy
wEditor.Application.Selection.Paste
With mail
.TO = ActiveSheet.Range("D2").Value
.Subject = "Test"
.send
End With
ActiveWindow.SelectedSheets.Delete
Sheets("Pivot").Select
ActiveCell.Offset(1, 0).Select
Loop
Sheets("Pivot").Select
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = False
End Sub