incohérence sur une macro envoie email

bonjour
j'ai un petit problème d’incohérence sur une macro envoie email
j'ai deux macro la 6 et la 7 qui utilise le même code chaque macro envoie les feuilles spécifiés
la macro 6 fonctionne parfaitement et la 7 bloque sur msg Send "impossible de reconnaître un ou plusieurs nom"
d'ou provient l'erreur je vous met les 2 macro

Sub macro6()
Dim rep As Integer

rep = MsgBox("Voulez-vous envoyer le Reporting PHOTOBOX ?", vbYesNo + vbQuestion, "Envoie Email Photobox")
If rep = vbYes Then
Application.ScreenUpdating = False
répertoireAppli = "C:\Archives photobox\Dossier tempo pour email"
Sheets(Array("Reporting palettes par mois", "Reporting complet")).Copy
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs répertoireAppli & "\Reporting PHOTOBOX du " & _
Format(Worksheets("Reporting palettes par mois").Range("E3"), "d\-mm\-yyyy") & ".xls"
ActiveWindow.Close
'--- Envoi par mail
Dim olapp As Object 'Outlook.Application
Sheets("Envoie Email").Select
Range("B41").Select
Set olapp = CreateObject("Outlook.Application")
Do While Not IsEmpty(ActiveCell)
Dim msg As Object 'MailItem
Set msg = olapp.CreateItem(0)
msg.To = ActiveCell.Value
msg.To = ActiveCell.Value
msg.Subject = Range("B28").Value
msg.CC = Range("b48").Value
msg.Body = Range("B31").Value & Chr(13) & Range("B32").Value & Chr(13) & Range("B33").Value & Chr(13) & Range("B34").Value & Chr(13) & Chr(13) & Range("B35").Value & Chr(13) & Range("B38").Value & Chr(13)
msg.Attachments.Add répertoireAppli & "\Reporting PHOTOBOX du " & _
Format(Worksheets("Reporting palettes par mois").Range("E3"), "d\-mm\-yyyy") & ".xls"
msg.Send
ActiveCell.Offset(1, 0).Select
Loop
Set msg = Nothing
Set olapp = Nothing

Application.ScreenUpdating = True
MsgBox "le Reporting PHOTOBOX a été envoyé par email avec succés ...."

Else

End If
End Sub



Sub macro7()
Dim rep As Integer

rep = MsgBox("Voulez-vous envoyer l'email ?", vbYesNo + vbQuestion, "Envoie Email Photobox")
If rep = vbYes Then


répertoireAppli = "C:\Archives photobox\Dossier tempo pour email"
Sheets(Array("A compléter", "Récap info CMR", "cmr DPD", "cmr royal mail ")).Copy
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs répertoireAppli & "\Consolidation des UK Arvato&Sartrouville du " & _
Format(Worksheets("A compléter").Range("c2"), "d\-mm\-yyyy") & ".xls"
ActiveWindow.Close
'--- Envoi par mail
Dim olapp As Object 'Outlook.Application
Sheets("Envoie Email").Select
Range("B87").Select
Set olapp = CreateObject("Outlook.Application")
Do While Not IsEmpty(ActiveCell)
Dim msg As Object 'MailItem
Set msg = olapp.CreateItem(0)
msg.To = ActiveCell.Value
msg.Subject = Range("B74").Value
msg.CC = Range("b93").Value
msg.Body = Range("B77").Value & Chr(13) & Chr(13) & Range("B78").Value & Chr(13) & Chr(13) & Range("B79").Value & Chr(13) & Chr(13) & Range("B80").Value & Chr(13) & Chr(13) & Range("A81").Value & Chr(13) & Chr(13) & Range("B84").Value & Chr(13) & Chr(13)
msg.Attachments.Add répertoireAppli & "\Consolidation des UK Arvato&Sartrouville du " & _
Format(Worksheets("A compléter").Range("c2"), "d\-mm\-yyyy") & ".xls"
msg.Send
ActiveCell.Offset(1, 0).Select
Loop
Set msg = Nothing
Set olapp = Nothing


MsgBox "La Consolidation des UK Arvato&Sartrouville a été envoyé par email avec succés ...."
Else

End If
End Sub


une idée du probleme

Julie