Joindre le fichier actuellement en cours

Bonjour tout le monde,

Je me permets de vous solliciter, car je suis bloqué : chaque mois je dois filtrer mes données selon les entreprises prestataires et leur envoyer un récapitulatif de toutes leurs interventions du mois. Pour se faire, j'essaie juste d'étudier le cas pour un prestataire jusqu'à l'envoi du mail avant de mettre ma boucle en place cependant même le cas sans boucle j'y arrive pas : j'aimerais joindre directement le fichier en question sans passer par la fenêtre qui nous dis de choisir manuellement le fichier.

Est-ce que vous pouvez m'aider s'il vous plaît.

Option Explicit

Dim Chemin As String, nomFichier As String, message As String, sujet As String, adresse As String, pj As String
Dim OutlookApp As Object, OutlookMail As Object

Sub filtre_amirat_pdf()

On Error Resume Next

nomFichier = Chemin & "Décompte STT EDF mai 2020.xls"
Chemin = "C:\Users\ABASKARAN\Documents\Data\"

        ThisWorkbook.Sheets("Conso_Mois2").Select

    Application.ScreenUpdating = False

        ActiveSheet.Range("J:M").EntireColumn.Hidden = True
        ActiveSheet.Range("$A$1:$M$500").AutoFilter Field:=17, Criteria1:="AMIRAT"
        Cells.Select
        Selection.Copy
        ActiveSheet.Range("J:M").EntireColumn.Hidden = False

        Workbooks.Add
        Sheets("Feuil1").Name = "EDF"
        Range("A1").Select
        ActiveSheet.Paste
        Application.CutCopyMode = False
        Columns("A:J").EntireColumn.AutoFit

    'Application.DisplayAlerts = False
         ChDir _
            "C:\Users\ABASKARAN\Documents\Data\"
        ActiveWorkbook.SaveAs Filename:=nomFichier, _
        FileFormat:=xlExcel8, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
    'Application.DisplayAlerts = True
        'ActiveWindow.Close

    Application.ScreenUpdating = True

    'initialisation de la pièce jointe
    pj = Application.GetOpenFilename("Tous les fichiers(*.*),*.*")

    ' Récupération de l'adresse mail associée à l'employé.
    adresse = ThisWorkbook.Sheets("BDD Partenaires").Range("C2").Value

    If adresse <> "" Then
    'Initialisation des variables
        sujet = "[Circet] Décompte de la société " & ThisWorkbook.Worksheets("Conso_Mois").Range("M2").Value
        message = "Bonjour," & Chr(10) & Chr(13) & "Veuillez trouver ci-joint le bilan du mois de mai 2020"

    'Création du mail
        Set OutlookApp = CreateObject("outlook.Application")
        Set OutlookMail = OutlookApp.CreateItem(0)
            With OutlookMail
                .Subject = sujet
                .To = adresse
                .Body = message
                .Attachments.Add ActiveWorkbook.FullName
                .Display 'visualiser le mail avant d'envoyer
                '.Send 'créer et envoyer directement

            End With

    End If

End Sub

Voici la macro actuelle*

Bonjour

Dans votre fichier on ne trouve pas la feuille Conso_mois2 que vous référencez au début du code

j'aimerais joindre directement le fichier en question sans passer par la fenêtre qui nous dis de choisir manuellement le fichier.

Désactivez cette ligne

pj = Application.GetOpenFilename("Tous les fichiers(*.*),*.*")

Ensuite plus bas quel est le fichier que vous voulez envoyer ? celui avec la feuille EDF ?

Cordialement

Edit : Essayez comme ceci

Sub filtre_amirat_pdf()
Dim Chemin As String, nomFichier As String, message As String, sujet As String, adresse As String, pj As String
Dim OutlookApp As Object, OutlookMail As Object

On Error Resume Next

Chemin = "C:\Users\ABASKARAN\Documents\Data\"
nomFichier = "Décompte STT EDF mai 2020.xls"

Application.ScreenUpdating = False

With ThisWorkbook.Sheets("Conso_Mois")
    .Select
    .Range("J:M").EntireColumn.Hidden = True
    .Range("$A$1:$M$500").AutoFilter Field:=17, Criteria1:="AMIRAT"
    .Cells.Copy
    .Range("J:M").EntireColumn.Hidden = False
End With

Workbooks.Add
With Sheets("Feuil1")
    .Name = "EDF"
    .Range("A1").Paste
    .Columns("A:J").EntireColumn.AutoFit
End With

ActiveWorkbook.SaveAs Filename:=Chemin & nomFichier ', _

Application.ScreenUpdating = True

    ' Récupération de l'adresse mail associée à l'employé.
adresse = ThisWorkbook.Sheets("BDD Partenaires").Range("C2").Value

    If adresse <> "" Then
    'Initialisation des variables
        sujet = "[Circet] Décompte de la société " & ThisWorkbook.Worksheets("Conso_Mois").Range("M2").Value
        message = "Bonjour," & Chr(10) & Chr(13) & "Veuillez trouver ci-joint le bilan du mois de mai 2020"

    'Création du mail
        Set OutlookApp = CreateObject("outlook.Application")
        Set OutlookMail = OutlookApp.CreateItem(0)
            With OutlookMail
                .Subject = sujet
                .To = adresse
                .Body = message
                .Attachments.Add ActiveWorkbook.FullName
                .Display 'visualiser le mail avant d'envoyer
                '.Send 'créer et envoyer directement
            End With

    End If

End Sub

Bonjour,

Merci de ta réponse!

C'est la feuille "Conso_Mois" tout court, désolé j'ai confondu avec le nom du classeur en question.

Oui, le fichier que je veux envoyer est bien celui avec la feuille EDF. Le code que vous m'avez proposé est fonctionnel, cependant au niveau du copier/coller y a un problème (d'ailleurs ça m'arrive souvent) : la macro ne colle pas l'élément copier du classeur Conso_Mois2.

J'aimerais savoir au passage à quoi sert l'instruction suivante s'il vous plaît :

Application.DisplayAlerts = False
Application.DisplayAlerts = True

Merci d'avance!

PS : J'aimerais également savoir, la ligne

On Error Resume Next

J'aimerais savoir au passage à quoi sert l'instruction suivante s'il vous plaît :

Application.DisplayAlerts = False
Application.DisplayAlerts = True

Placée dans un code, cette instruction évite d'avoir un message qui est par défaut renvoyé par excel. Exemple : lorsque vour fermez un fichier que vous avez modifié. Excel va vous demander si vous voulez enregistrer les modifications. Avec cette instruction mise à FALSE, vous n'aurez pas ce message et excel fera directement l'action sans vous demander votre avis.

la macro ne colle pas l'élément copier du classeur Conso_Mois2.

Je pense que cela vient du fait que vous copier puis vous créer un nouveau fichier. Cette opération enlève peut être les infos de copie dans le presse papier. essayez de modifier cette partie de code comme ceci :

Workbook.Add
With ThisWorkbook.Sheets("Conso_Mois")
    .Select
    .Range("J:M").EntireColumn.Hidden = True
    .Range("$A$1:$M$500").AutoFilter Field:=17, Criteria1:="AMIRAT"
    .Cells.Copy ActiveWorkbook.Range("A1")
    .Range("J:M").EntireColumn.Hidden = False
End With

'Workbooks.Add
With ActiveWorkbook.Sheets("Feuil1")
    .Name = "EDF"
    '.Range("A1").Paste
    .Columns("A:J").EntireColumn.AutoFit
End With

-PS : J'aimerais également savoir, la ligne

On Error Resume Next

-c'est une instruction pour que le code continue de se compiler malgré les alertes d'erreurs c'est cela ?

Exact !

Merci beaucoup pour les explications!

Je viens d'essayer le bout de code en question mais toujours rien, le copier/coller ne fonctionne toujours pas. J'ai essayé avec le code

Application.CutCopyMode = True
Application.CutCopyMode = False

Mais bon, toujours sans succès.

Bonjour

Essayez comme ceci. Chez moi cela a fonctionné

Workbooks.Add
With ThisWorkbook.Sheets("Conso_Mois")
    '.Select
    .Range("J:M").EntireColumn.Hidden = True
    .Range("$A$1:$M$500").AutoFilter Field:=17, Criteria1:="EDF"
    .Range("C1:Q" & .Range("C" & .Rows.Count).End(xlUp).Row).Copy ActiveWorkbook.Sheets(1).Range("A1") '.Cells.Copy
    .Range("J:M").EntireColumn.Hidden = False
End With

With ActiveWorkbook.Sheets("Feuil1")
    .Name = "EDF"
    .Columns("A:J").EntireColumn.AutoFit
End With
End Sub

J'ai changé AMIRAT par EDF car je n'avais pas de AMIRAT en colonne 17.

Crdlt

Salut,

Oui vous avez bien fait, excusez-moi j'essayais de réadapter la macro dans mon cas ^^'

ça marche nickel cette fois-ci, merci beaucoup !

+ d'ailleurs merci, j'essayais d'optimiser la macro en question en utilisant la fonction Rows.Count mais je savais pas trop comme synthétiser ça, merci beaucoup !