XL 2010 Generer un fichier Excel sans les elements filtres

[amincewo]

Bonjour,

J'ai des affaires qui sont reparties entre plusieurs vendeurs.
Je souhaite envoyer a la semaine la liste des affaires par vendeur pour qu'il puisse commente l'avancee des affaires et renvoye le fichier complete (extraction SAP a la base).
J'ai cree une macro qui marche et qui me permet a partir du fichier global de generer un filtre par vendeur puis de l'envoyer directement par mail (onglet actif seulement).
Cependant le fichier genere contient encore la totalite des infos quand on enleve le filtre.
Je voudrais envoye uniquement les donnees relatives au vendeur en question.

Avez-vous une solution ?
Je suis debutant.

Merci

Ci dessous la macro tel qu'elle est :

Sub Filtre()
'
' Test2 Macro
'
ActiveSheet.Range("$A$4:$z$1000").AutoFilter Field:=1, Criteria1:=ActiveSheet.Range("a2")

End Sub

Sub Send()

Dim xFile As String
Dim xFormat As Long
Dim Wb As Workbook
Dim Wb2 As Workbook
Dim FilePath As String
Dim FileName As String
Dim OutlookApp As Object
Dim OutlookMail As Object
On Error Resume Next
Application.ScreenUpdating = False
Set Wb = Application.ActiveWorkbook
ActiveSheet.Copy
Set Wb2 = Application.ActiveWorkbook
Select Case Wb.FileFormat
Case xlOpenXMLWorkbook:
xFile = ".xlsx"
xFormat = xlOpenXMLWorkbook
Case xlOpenXMLWorkbookMacroEnabled:
If Wb2.HasVBProject Then
xFile = ".xlsm"
xFormat = xlOpenXMLWorkbookMacroEnabled
Else
xFile = ".xlsx"
xFormat = xlOpenXMLWorkbook
End If
Case Excel8:
xFile = ".xls"
xFormat = Excel8
Case xlExcel12:
xFile = ".xlsb"
xFormat = xlExcel12
End Select
FilePath = Environ$("temp") & "\"
FileName = "Follow-Up" & "_" & Range("a2").Value & "_" & Format(Now, "dd-mmm-yy")
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)
Wb2.SaveAs FilePath & FileName & xFile, FileFormat:=xFormat
With OutlookMail
.To = Range("b2").Value
.CC = ""
.BCC = ""
.Subject = "Test"
.Body = "Test"
.Attachments.Add Wb2.FullName
.Send
End With
Wb2.Close
Kill FilePath & FileName & xFile
Set OutlookMail = Nothing
Set OutlookApp = Nothing
Application.ScreenUpdating = True
End Sub

 

[Robert]

Bonjour Amincewo, bonjour le forum,

Peut-être comme ça :
- Ouvre un fichier vierge et sauve-le Test.xlsx puis modifie le code du filtre :

Sub Filtre()
Dim PL As Range
Dim PLV As Range
Dim CD As Workbook
Dim OD As Worksheet

Set PL = ActiveSheet.Range("A4:Z1000")
ActiveSheet.Range("$A$4:$z$1000").AutoFilter Field:=1, Criteria1:=ActiveSheet.Range("A2")
Set PLV = PL.SpecialCells(xlCellTypeVisible)
Set CD = Worksbooks("TEST.xlsx")
Set OD = CD.Worksheet(1)
OD.Cells.ClearContents
PLV.Copy OD.Range("A1")
End Sub

- Puis, plutôt que d'envoyer le fichier source par email envoie le fichier TEST.xlsx.