Filter Data and Email then Refilter Data and Email.

[dataislife]

Hello,

This is my first post. I am managing a group of 20 salesmen. I want to send each salesmen a report every week but I don't want to do it manually.

Is there an easier way to do this?

I am thinking VBA and advanced filter.

How do i post my spreadsheet?

Thanks,

 

[dataislife]

Every salesmen is linked to a number (1-20). I change Cell C1 to get a different salesmen. I am using vlookup and advanced filter.


Sub Mail_every_Worksheet()
Dim sh As Worksheet
Application.ScreenUpdating = False
Range("C1").Select
ActiveCell.FormulaR1C1 = "1"
Range("A4").Select
Range("A4:H9").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range _
("B1:B2"), Unique:=False
For Each sh In ThisWorkbook.Worksheets
If sh.Range("a1").Value Like "*@*" Then
sh.Copy
ActiveWorkbook.SaveAs "Sheet " & sh.Name & " of " _
& ThisWorkbook.Name & ".xls"
ActiveWorkbook.SendMail ActiveSheet.Range("a1").Value, _
"Subject_line"
ActiveWorkbook.ChangeFileAccess xlReadOnly
Kill ActiveWorkbook.FullName
ActiveWorkbook.Close False
End If
Next sh
Application.ScreenUpdating = True
Range("C1").Select
ActiveCell.FormulaR1C1 = "2"
Range("A4").Select
Range("A4:H9").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range _
("B1:B2"), Unique:=False
For Each sh In ThisWorkbook.Worksheets
If sh.Range("a1").Value Like "*@*" Then
sh.Copy
ActiveWorkbook.SaveAs "Sheet " & sh.Name & " of " _
& ThisWorkbook.Name & ".xls" ActiveWorkbook.SendMail ActiveSheet.Range("a1").Value, _
"Subject_line"
ActiveWorkbook.ChangeFileAccess xlReadOnly
Kill ActiveWorkbook.FullName
ActiveWorkbook.Close False
End If
Next sh
Application.ScreenUpdating = True
End Sub


I am getting a run-time error "1004"
The file name or path does not exist.
the file is being used by another program.
the workbook you are trying to save has the same name as the currently open workbook.