For the looping through the salesmen. Maybe the displayalerts will hide the unwanted messagebox. Not sure cause I can't test it now.
Sub Mail_Range()
Dim mysalespeople
Sheets("Table").Select
Range("A2").Select
'Andy, Fairport, Charlize are the names of your salespeople
For Each mysalespeople In Array("Andy", "Fairport", "Charlize")
ActiveSheet.PivotTables("PivotTable1").PivotCache.Refresh
ActiveWindow.ScrollColumn = 1
ActiveSheet.PivotTables("PivotTable1").PivotFields("Salesman").ClearAllFilters
'Loop through all your salespeople
ActiveSheet.PivotTables("PivotTable1").PivotFields("Salesman").CurrentPage = _
mysalespeople
Range("K2").Select
'Working in 2000-2007
Dim Source As Range
Dim Dest As Workbook
Dim wb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim FileFormatNum As Long
Set Source = Nothing
On Error Resume Next
Set Source = Range("K5:s500").SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Source Is Nothing Then
MsgBox "The source is not a range or the sheet is protected, " & _
"please correct and try again.", vbOKOnly
Exit Sub
End If
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set wb = ActiveWorkbook
Set Dest = Workbooks.Add(xlWBATWorksheet)
Source.Copy
With Dest.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial Paste:=xlPasteValues
.Cells(1).PasteSpecial Paste:=xlPasteFormats
.Cells(1).Select
Application.CutCopyMode = False
End With
TempFilePath = Environ$("temp") & "\"
TempFileName = "Selection of " & wb.Name & " " _
& Format(Now, "dd-mmm-yy h-mm-ss")
If Val(Application.Version) < 12 Then
'You use Excel 2000-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007
FileExtStr = ".xls": FileFormatNum = -4143
End If
'Not sure if this would help to hide the messagebox
'concerning the saving.
Application.DisplayAlerts = False
With Dest
.SaveAs TempFilePath & TempFileName & FileExtStr, _
FileFormat:=FileFormatNum
On Error Resume Next
Application.DisplayAlerts = True
'If the mailaddress before @ is the same as the name of mysalespeople,
'your in luck, otherwise you'll have to use andy$andy@abcdefg.com
'ie array("andy$andy@abcdefg.com","fairport$fairport@abcdefg.com")
'then with split(mysalespeople,"$")(0) you've got the name
'and with split(mysalespeople,"$")(1) you've got the mailaddress
.SendMail mysalespeople & "@abcdefgh.com", _
"Trial select cell email to " & mysalespeople
On Error GoTo 0
.Close SaveChanges:=False
End With
Kill TempFilePath & TempFileName & FileExtStr
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
'next name
Next mysalespeople
End Sub
Charlize
Bookmarks