Bonjour,

Après des heures de recherches sur le net, je viens de trouver un fichier Excel composé de 3 onglets et d'un module dont le code est le suivant :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
Option Explicit
 
Sub envoi_Feuille()
Dim olapp As Outlook.Application
Dim malist, Count, Envoi, AdresseRépertoire As Variant
 On Error Resume Next
            '-------Contrôler dans Bisual Basic/Outils/Références/que Microsoft Outlook --,- Object Librairy est bien coché
Dim adresse(1 To 10)
            '----------------------Création de la liste d'adresses mail contenus de la ligne 2 à 10
Set malist = Sheets("Feuil1").Range("A2:A10")
Count = 1
For Each Envoi In malist
If Len(Envoi) Then adresse(Count) = Envoi: Count = Count + 1
Next
            '----------------------Copie de la liste d'adresse dans une cellule vide exemple H1
[H1] = Array(adresse(1) & "; " & adresse(2) & "; " & _
adresse(3) & "; " & adresse(4) & "; " & adresse(5) & "; " & adresse(6), adresse(7), adresse(8), adresse(9), adresse(10))
            '-------adresse du répertoire ou sera enregistré le fichier
AdresseRépertoire = ActiveWorkbook.Path
            '---------------------copie de la feuille à envoyer
Application.DisplayAlerts = False
Sheets("Feuil2").Copy
            '---------------------Nom du fichier à envoyer
ActiveWorkbook.SaveAs AdresseRépertoire & "\" & "Class.xls" ' ou adresse si le nom est dans une cellule  Range("E2").Value & ".xls"
ActiveWindow.Close
            '---------------------Envoi par mail
Sheets("Feuil1").Select
Range("H1").Select
            '---------------------contrôle la validité ou la présence d'adresse mail en H1
If [H1] Like "*@*" Then
            '---------------------Le mail est envoyé que si y a des adresses feuille 1 en H1
Do While Not IsEmpty(ActiveCell)
Dim msg As MailItem
Set olapp = New Outlook.Application
Set msg = olapp.CreateItem(olMailItem)
msg.To = Range("H1").Value 'Adresse de la cellule contenant la liste des adesses mails
            '--------------------Saisir le sujet de l'envoi
msg.Subject = "Coucou c'est moi "  ' ou saisir le sujet dans une cellule ex. Range("H2").Value
            '---------------------saisie du message
msg.Body = "Bonjour" & Chr(13) & Chr(13) & "Veuillez trouver ci-joint" & Chr(13) & "copie du dossier" & Chr(13) & Chr(13) & "Cordialement"
            '---------------------ou saisir le message dans des cellules
'msg.Body = Range("E5").Value & Chr(13) & Chr(13) & Range("E8").Value & Chr(13) & Chr(13)& Range("E10").Value
            '---------------------ou saisir le message dans des cellules
            '---------------------Adresse de la pièce jointe
msg.Attachments.Add Source:=AdresseRépertoire & "\" & "Class.xls" ' ou adresse si le nom est dans une cellule  Range("E2").Value & ".xls"
msg.Send
            '---------------------effacement de la liste d'envoi
[H1].ClearContents
Loop
Else
MsgBox "Aucune adresse valide sélectionnée"
End If
Application.ScreenUpdating = True
End Sub
Aucune complication pour comprendre ce code, la macro fonctionne correctement mais mon souci est le suivant :

Lorsque je veux intégrer ces 3 feuilles ainsi que le code dans un autre fichier Excel (ma base de données composée de 15 feuilles renommées autrement que Feuil1, Feuil2, ...., Feuil15) çà bug dans le code.

Si je renomme également les 3 feuilles du présent classeur (fichier joint) et que je modifie également le nom des feuilles dans le code Vba, çà bug aussi.

Sinon La feuille 3 a-t-elle une importance primordiale vu qu'elle n'est pas utilisée dans le code ?

Quelqu'un aurait il une solution à me proposer pour résoudre ce bug ?

Cordialement.