Probleme sélection sur mail auto

bonjour à tous,

j'aimerai créer un mail auto hebdo (j'ai pas encore réglé la fréquence) avec un extract d'une partie de ma feuille après un filtre.

Sub Send_RangeR()

feuille = Year(Date)

' pour les réparations
With Sheets("" & feuille & "")
On Error Resume Next
Sheets("" & feuille & "").ShowAllData                           'on reinitialise tous les filtres
On Error Goto 0                                            .
Set plage = .Range(.Cells(8, 1), .Cells(.Rows.Count, 384).End(xlUp))
plage.AutoFilter Field:=8, Criteria1:="<" & CLng(CDate((Date) - 30))                  'filtre si delai > 30j

lr = .Range("B" & .Rows.Count).End(xlUp).Row
ActiveSheet.Range("A7:B" & lr & ",H7:H" & lr & ",K7:K" & lr).SpecialCells(xlVisible).Select   'partie à sélectionner sans cellules masquées

ActiveWorkbook.EnvelopeVisible = True

End With

With Sheets("" & feuille & "").MailEnvelope            'création du mail
    .Introduction = "This is a test."
    .Item.To = "pinpol@bidule.fr"
    .Item.Subject = "En réparation"
    .Item.Send                            'arrivée du popup excel
End With
End Sub

mon problème est que:

• la sélection se fait bien, mais dans le mail, j'ai la feuille entière....
• vu qu'il y a des parties masquées, j'ai une MSGBOX d'Xcel qui bloque la procédure, et impossible à valider par VBA!

je vous joins le fichier.

le code est dans le module mail_ PJ.

en vous remerciant

Bonsoir,

ci-dessous proposition de code

Sub Send_RangeR()

   ' Select the range of cells on the active worksheet.
    feuille = CStr(Year(Date))

    ' pour les réparations
    With Sheets(feuille)
        On Error Resume Next
        .ShowAllData                           'on reinitialise tous les filtres

        Set plage = Range(.Cells(8, 1), .Cells(.UsedRange.Rows.Count, 384))
        plage.AutoFilter Field:=8, Criteria1:="<" & CLng(CDate((Date) - 30))                  'filtre si delai > 30j
        Sheets.Add after:=Sheets(.Index)
        With plage
            Union(.Columns("A:B"), .Columns("H"), .Columns("K")).SpecialCells(xlVisible).Copy Destination:=Range("A1")
        End With

        .ShowAllData                           'on reinitialise tous les filtres
    End With

    ActiveWorkbook.EnvelopeVisible = True
    With ActiveSheet
        .Columns("A:D").ColumnWidth = 30
        ' Set the optional introduction field thats adds
        ' some header text to the email body. It also sets
        ' the To and Subject lines. Finally the message
        ' is sent.
         With .MailEnvelope
             .Introduction = "This is a test."
             .Item.To = "f.fritsch@ams-france.eu"
             .Item.Subject = "En réparation"
             .Item.Send
        End With
        Application.DisplayAlerts = False
        .Delete
    End With
    ActiveWorkbook.EnvelopeVisible = False

End Sub

bonsoir et merci Thev pour ton boulot,

j'ai continué et pousser plus loin aujourd’hui avec un deuxième tableau sur le meme mail et rajout d'une colonne.

ça marche, mais je pense qu'il y a moyen d’être plus efficace dans le code.

donc à l'occas, si qqun peut simplifier ce code...

merci bcp.

Sub Send_RangeR()
Application.ScreenUpdating = False
   ' Select the range of cells on the active worksheet.
    feuille = CStr(Year(Date))
    Sheets.Add(after:=Sheets(feuille)).Name = "filtres"

    ' pour les réparations
    With Sheets(feuille)
        On Error Resume Next
        .ShowAllData                           'on reinitialise tous les filtres

        Set plage = Range(.Cells(7, 1), .Cells(.UsedRange.Rows.Count, 384))
        plage.AutoFilter Field:=8, Criteria1:="<" & CLng(CDate((Date) - 30))               'filtre si delaiR > 30j
        With plage
            Union(.Columns("A:C"), .Columns("H"), .Columns("K")).SpecialCells(xlVisible).Copy Destination:=Range("A1")
        End With
            Range("F1") = "Durée"                           'Mise en forme de la colonne 'durée
            Range("F1").Font.ColorIndex = 2                    'texte en blanc
            Range("F1").Interior.ColorIndex = 1                 'fond en noir
            Range("F2").FormulaLocal = "=AUJOURDHUI()-D2"       'formule
            Range("F2:F" & Range("B" & .Rows.Count).End(xlUp).Row).Select       'selection de la plage
            Selection.FillDown                              'deroule la formule
            Selection.Borders.ColorIndex = 1                    'bordure

        .ShowAllData                           'on reinitialise tous les filtres

        plage.AutoFilter Field:=5, Criteria1:="<" & CLng(CDate((Date) - 15))               'filtre si delaiE > 15j
        With plage
            Union(.Columns("A:B"), .Columns("E")).SpecialCells(xlVisible).Copy Destination:=Range("A" & Range("A" & .Rows.Count).End(xlUp).Row + 2)
        End With
        NoLig = Range("F" & .Rows.Count).End(xlUp).Row + 2      'Nbre de ligne du 1er tableau +2 = 1ere ligne du nouveau tableau
            Range("D" & NoLig) = "Durée"
            Range("D" & NoLig).Font.ColorIndex = 2
            Range("D" & NoLig).Interior.ColorIndex = 1
            Range("D" & NoLig + 1).FormulaLocal = "=AUJOURDHUI()-C" & NoLig + 1
            Range("D" & NoLig + 1 & ":D" & Range("A" & .Rows.Count).End(xlUp).Row).Select
            Selection.FillDown
            Selection.Borders.ColorIndex = 1

        .ShowAllData                           'on reinitialise tous les filtres
        Range("A1").Select                      'select ailleurs sinon envoie que de la sélection
    End With

    ActiveWorkbook.EnvelopeVisible = True

    With ActiveSheet
            .Columns("B:E").ColumnWidth = 30
            .Columns("A:F").HorizontalAlignment = xlHAlignCenter

'preparation du mail
         With .MailEnvelope                      'envoie du mail
             .Introduction = "This is not a test."      'texte
             .Item.To = "paullepoulpe@lamer.eu"   'adresse mail
             .Item.Subject = "A relancer"           'sujet
             .Item.Send
        End With
        Application.DisplayAlerts = False           'masque le popup excel
        .Delete                                         ' efface la feuille créée
    End With
    Sheets(feuille).Select
    ActiveWorkbook.EnvelopeVisible = False

End Sub