Fusion de 2 VBA


#1

Bonjour,

J’aurai besoin d’aide car je n’arrive pas assembler plusieurs macro VBA.
J’ai dans mon dossier personnel vba, un macro qui dispatch des onglets dans un fichier.

Et ensuite, j’ai un fichier avec une macro qui envoi en automatique mes fichiers dans un dossier (sans que j’ouvre les fichiers).

Je voudrais sur ce fichier de macro qui envoi en automatique, pouvoir dispatcher mes onglets sans ouvrir les fichiers puis qu’ils soient envoyer.

Sub DispatchOngletaClasseur()

 Dim resultat As String
 
 resultat = InputBox("Bonjour, veuillez renseigner le titre à ajouter derrière le nom du magasin.", "titre") 'La variable reçoit la valeur entrée dans l'InputBox

 If resultat <> "" Then 'Si la valeur est différente de "" on affiche le résultat
    MsgBox resultat
 End If

MsgBox "Merci !"

For Each feuille In ActiveWorkbook.Sheets

feuille.Copy

With ActiveWorkbook
    .Title = feuille.Name

    .Subject = feuille.Name

    .SaveAs Filename:=feuille.Name + resultat + ".xlsx"

End With

ActiveWindow.Close

Next

MsgBox "Les fichiers ont été enregistrés dans votre dossier principal. Bonne journée ! "

End Sub

Sub SuppLigne()

’ Macro2 Macro
’ Macro enregistrée le 25/05/2012 par XXXXX

Windows(“Fichier pour envoi TDB par mail.xls”).Activate
Sheets(“BASE”).Select
Rows(“16:16”).Select
Selection.Copy
Rows(“15:15”).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Rows(“16:16”).Select
Selection.Delete Shift:=xlUp

Application.Run ("Envoi")

End Sub

Sub Test()

’ SuppLigne Macro
’ Macro enregistrée le 18/05/2012 par XXXXX

'For i = 1 To 192

Application.Wait (Now + TimeValue("00:00:01"))
Application.Run "Send_Mails"
Application.Run "SuppLigne"

’ Next

End Sub

Sub Send_Mails()
’ envoie de message via outlook

Dim appOutLook As Object

Dim MailOutLook As Object

Dim Fichier As String

Dim rep_fic As String

rep_fic = [FICHE] '“C:\Users\anthony\Documents\STATISTIQUES\TDB FDM\2018\2018-10\Vide TDB 2018-10.xls”

Set appOutLook = CreateObject(“Outlook.Application”)
Set MailOutLook = appOutLook.CreateItem(olMailItem)

With MailOutLook

'où se trouve l’adresse du destinataire

.To = Worksheets(“BASE”).Range(“C11”)

.Subject = “Fichier Tableau de bord - Mois & Cumul”

'.Body = “Bonjour, Ce message est envoyé par un processus automatique, veuillez ne pas y répondre. Cordialement”
.Body = "Bonjour, " & vbCrLf & vbCrLf & "Veuillez trouver en pièce jointe le tableau de bord mois et cumul. " & vbCrLf & vbCrLf & “Cordialement,” & vbCrLf & vbCrLf & “Contrôle de Gestion Réseau.”

'Seulement si tu veux joindre un fichier

'If rep_fic <> “” Then
.Attachments.Add rep_fic
’ End If

.Display
’ pour envoie automatique
.Send

End With

Set MailOutLook = Nothing
Set appOutLook = Nothing
Set VariableObjet = Nothing

End Sub