Hi Every one,

Following is a code that prints out weekly individual task lists from a
master Critical Path.

The code first creates a list of unique individuals on a temporary page,
- then filter my critical path in a Column called "Next week" to only show
action requiring follow-up on following week.
- then prints-out a list of individuals who will receive task lists,
- and finaly loops through alll values in "MyUniqueRng" to filter and print
out the list name by name.

What I would like to do, is instead of Printing-out these individuals task
lists,
sending them by e-mail whith outlook

So first it means that after filtering the list by employee's names one by
one the macro must:
- Create a folder in My Document & name it "Task Lists - Current Date"
- Create a workbook and name it with Mycell Value (Name of
employee)followed by current date
- Paste the filetered list (Only visible part) to the workbook nwe have just
created

- vlookup for the employee's e-mail address

- send it to the employee by e-mail with outlook

- store the workbook in the folder created by the macro befor the loop.

(Provided that all names are listed on another separate sheet (Whole list
of
employees) and that I would write their e-mail addresses on a column at the
right of the "Name" column, I assume that by a loop through the range
"MyUniqueRng" combined to a V-Lookup these addresses could easily be pasted
in Outlook to send individual e-mails. )


It would be great If somebody could assist me in this matter.

Thanks,

Paul



Sub Print_Next_Weeek_Task_Lists()

Application.ScreenUpdating = False
Dim newWks As Worksheet
Dim curWks As Worksheet
Dim myRng As Range
Dim myRng2 As Range
Dim myUniqueRng As Range
Dim myCell As Range


Set curWks = Sheets("Critical Path")
Set newWks = Worksheets.Add

With curWks
.AutoFilterMode = False
Set myRng = .Range("A6", .Cells.SpecialCells(xlCellTypeLastCell))
Set myRng2 = .Range("A5", .Cells.SpecialCells(xlCellTypeLastCell))
myRng2.AutoFilter Field:=16, Criteria1:="<"
myRng.Columns(4).Copy _
Destination:=newWks.Range("a1")
With newWks
.Range("a1", .Cells(.Rows.Count, "a")).AdvancedFilter _
Action:=xlFilterCopy, CopyToRange:=.Range("b1"), Unique:=True
.Range("b:b").Sort Key1:=Range("b1"), _
Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom
Set myUniqueRng = .Range("b1", .Cells(.Rows.Count,
"b").End(xlUp))
End With

With Sheets("Task List Distribution NW") ' Prints Task List
Distribution Record
myUniqueRng.Copy
Sheets("Task List Distribution NW").Select
Range("A7").PasteSpecial (xlPasteValues)
.PrintOut Copies:=1, preview:=False
Range("A7:A60").ClearContents
End With


.Range("L4").Value = "Next Week"
''''LOOP STARTS
For Each myCell In myUniqueRng.Cells
myRng2.AutoFilter Field:=4, Criteria1:=myCell.Value
.Range("O3").Value = myCell.Value
.PrintOut Copies:=1, preview:=False
Next myCell
'''''LOOP STOPS
.Range("O3:P3").ClearContents
.Range("L4").ClearContents
If .FilterMode Then
.ShowAllData
End If

End With

Application.DisplayAlerts = False
newWks.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub