Création de boucle - envoie de mail avec PJ sous excel

Bonjour à tous,

J'ai un petit soucis lors de la création d'une boucle dans ma macro d'envoi de mail sous excel avec PJ.

Ma macro à deux partie imbriquées :

1 : création des PJ

2 : envoie des mails


Dans mon exemple j'ai 4 onglet à transformer en PJ et à envoyer par mail (4 mail) , le soucis est que la macro stoppe aprés le 1er mail

Je précise qu'en ne renseignant que le code de création de PJ (sans la partie 'PARTIE ENVOIE DE MAILS), la boucle fonctionne et me créer bien 4 PJ ( 4 fichier excel enregistré dans un dossier)

Le soucis vient quand je rajoute le code envoie de mail et qu'il s'arrête à 1PJ créer et 1 mail envoyé

Ci dessous mon code :

---------------------

Sheets("TCD").Select
ActiveSheet.PivotTables("Tableau croisé dynamique1").ShowPages PageField:= _
"MAIL"



Do While ActiveSheet.Name <> "TCD" Or ActiveSheet.Name <> "base clients" Or ActiveSheet.Name <> "base TCD" Or ActiveSheet.Name <> "MACRO" Or ActiveSheet.Name <> "ISUZU" Or ActiveSheet.Name <> "ISUZU_2" Or ActiveSheet.Name <> "! Non Affecté !" Or ActiveSheet.Name <> "Impayés"

Dim ws As Worksheet

For Each feuille In ActiveWorkbook.Worksheets
If feuille.Name = "TCD" Or feuille.Name = "base clients" Or feuille.Name = "base TCD" Or feuille.Name = "MACRO" Or feuille.Name = "ISUZU" Or feuille.Name = "ISUZU_2" Or feuille.Name = "! Non Affecté !" Or feuille.Name = "Impayés" Then

Else

feuille.Move


Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False




Columns("A:E").Select
Columns("A:E").EntireColumn.AutoFit
Range("B6").Select
ActiveWindow.DisplayGridlines = False

x = Range("b1").Value
y = Range("b2").Value
z = Range("d4").Value


Range("b1").Select

chemin = "chemin du fichier \"
nomfic = y

ActiveWorkbook.SaveAs Filename:=chemin & nomfic, FileFormat:=xlWorkbookDefault
ActiveWorkbook.Close SaveChanges:=True



'PARTIE ENVOIE DE MAILS
Dim Dest As String
Dim CC As String
Dim Exp As String
Dim Suj As String
Dim Text As String





Dest = adresse mail
CC = adresse mail
Exp = adresse mail
Suj = "xxxxxxx" & y & ""
Text = "Bonjour," & vbCrLf & vbCrLf & _
"xxxxxxxx." & vbCrLf & _
"xxxxxxxxx" & vbCrLf & _
"." & vbCrLf & _
"xxxxxxxx." & vbCrLf & vbCrLf & _
"xxxxxx." & vbCrLf & vbCrLf & _
"" & vbCrLf & _
"xxxxxxxx" & vbCrLf & _
"xxxxxxx xx" & vbCrLf & _
" "


Dim Cdo_Message As Object
Set Cdo_Message = CreateObject("CDO.Message")

With Cdo_Message
.To = Dest
.From = Exp
.CC = CC
.Subject = Suj
.TextBody = Text
.AddAttachment ("chemin du fichier\" & y & ".xlsx")



.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = xxxxxxx

'nom du serveur smtp
.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "xxxxxxxxxx"

'port du serveur smtp
.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") =xxxxxxxxx

.Configuration.Fields.Update

.Send
End With

Set Cdo_Message = Nothing
MsgBox "Votre message a bien été envoyé", vbInformation
Exit Sub

err_handler:
MsgBox "Le message n'a pas pu être envoyé. Merci d'utiliser le VPN.", vbCritical


End If


Next

Loop



End Sub
------------------------------------------------------------------------------------------------

J'ai ajouté un do while + loop sans effet, je ne m'y prend surement pas de la bonne façon

Auriez vous une solution?