Outlook tableau croise

[jetted]

J'aimerais envoye un couriel avec outlook 2003 avec un tableau croise voir document ci joint
(echantillon seulement j'ai environ 700 email a envoye).

Le resultat final si possible devrait avoir quelque chose du genre
denise.dufour2@xxx.com
Devrait obtenir un courriel avec body (corps)
Re 2008-7583-HQ-1331-7583
2008-7584-HQ-1331-7584

denis.jette@xxx.com
Devrais obtenir un email avec le body(corps)
Re 2008-7583-HQ-1331-7583
2008-7584-HQ-1331-7584
2008-7600-HQ-1360-7600
2008-7603-HQ-6037-7603
2008-7605-HQ-6024-7605

Si ce n'est pas clair veuillez m'aviser
Merci a l'avance ca fais 2 jours que je me casse la tete

 

[jetted]

Re : Outlook tableau croise

J'aimerais envoye un couriel avec outlook 2003 avec un tableau croise voir document ci joint
(echantillon seulement j'ai environ 700 email a envoye).

Le resultat final si possible devrait avoir quelque chose du genre
denise.dufour2@xxx.com
Devrait obtenir un courriel avec body (corps)
Re 2008-7583-HQ-1331-7583
2008-7584-HQ-1331-7584

denis.jette@xxx.com
Devrais obtenir un email avec le body(corps)
Re 2008-7583-HQ-1331-7583
2008-7584-HQ-1331-7584
2008-7600-HQ-1360-7600
2008-7603-HQ-6037-7603
2008-7605-HQ-6024-7605

Si ce n'est pas clair veuillez m'aviser
Merci a l'avance ca fais 2 jours que je me casse la tete

Quelqu'un a une idee

 

[jetted]

Re : Outlook tableau croise

Bon j'ai trouver un workaround, au lieu de prendre le tableau croise j'ai pris la feuille original et j'ai utilise le code suivants:

Sub nouvelle_envoi()
    Dim findname As String
    Dim TheRng As Range
    Set TheRng = Range("c2:c1850")    ' set de range to count email address

    Dim olApp As Outlook.Application
    Dim olMail As MailItem
    Set olApp = New Outlook.Application

    Application.ScreenUpdating = False
    RowCount = Cells(Cells.Rows.Count, "c").End(xlUp).Row

    For i = 2 To RowCount
        Range("d" & i).Select
        lang = ActiveCell.Value    'check for language
        If lang = "E" Then
            Range("c" & i).Select
            findname = ActiveCell.Text
            compte = Application.CountIf(TheRng, findname)    'count how many email address
            For j = 2 To compte + 1
                nom = Range("b" & i).Value    'grab the name
                nemail = findname   ' grab the email addresss
                Range("f" & i).Select    'grab competition number
                posit = ActiveCell.Value
                positio = posit & vbNewLine & positio    'if more then 1 competition number
                i = i + 1
            Next j

            Set olMail = olApp.CreateItem(olMailItem)  'prepare le email
            With olMail
                .To = nemail  'adresse email
                .BCC = "denise.dufour2@cra-arc.gc.ca"     'faire un bcc
                .Subject = "CRA Job Opportunities"    'sujet
                .Body = "Dear " & nom & "," & vbCrLf & vbCrLf & _
                        "Re: " & positio & vbCrLf & _
                        "2ieme envoi test."
                'vbNewLine & vbNewLine & "Please send your email confirmation by reply email to Denise Dufour " & "(denise.dufour2@cra-arc.gc.ca)" & "." & " Thank you for your understanding and cooperation."
                .Display
                Application.Wait (Now + TimeValue("0:00:05"))
                Application.SendKeys "%S"
            End With
            Set olMail = Nothing    'enleve l'objet
        End If
        i = i - 1    'correct the loop for the next i
        posit = " "
        positio = " "

    Next i
End Sub