Thread: auto email filtered table

Hello,

Could someone help me with coding, I can't seem to quite make table filtering ( Code is not mine, I got it). I need it to filter 2 columns and only then copy active sheet in to new excel file.

Sub EmailActiveSheetWithOutlookDaugavpils()
    
    Dim oApp, oMail As Object, _
    tWB, cWB As Workbook, _
    FileName, FilePath As String

    Application.ScreenUpdating = False

'Set email id here, it may be a range in case you have email id on your worksheet
    
   ''Mailid = "TEMPLATE
   

'Write your email message body here , add more lines using & vbLf _ at the end of each line
    
    Body = "Labdien, " & vbLf _
    & vbLf _
    & "Nosūtam pārvadāju pasūtījumu uz " & Date + 1 & vbLf _
    & vbLf _
    & "Jūsu G4S DSA !"
    

'Copy Active Sheet and save it to a temporary file

'' PROBLEM PART HERE
    Set cWB = ActiveWorkbook
    With ActiveSheet
        .ListObjcts("Table1").Range.AutoFilter Field:=1, Criteria1:=Date + 1
        .ListObjcts("Table1").Range.AutoFilter Field:=2, Criteria1:="Rīga"
    ActiveSheet.Copy
    End With
    
    
    ''ActiveSheet.ListObjects("Table1").Sort.SortFields.
    ''ActiveSheet.PivotTables("PivotTable2").PivotFields("Datums").CurrentPage = Date
    ''ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=2, Criteria1:="Rīga"
    '', Field:=1, Criteria1:="Date"
    '' .Range.AutoFilter Field:=1, Criteria1:="Date"
    
    
     ''ActiveSheet.Copy
     
     
 ''PROBLEM PART HERE
 
    
    Set tWB = ActiveWorkbook
    FileName = "Pārvadājumi.xls" 'You can define the name
    FilePath = Environ("TEMP")
    
    On Error Resume Next
    Kill FilePath & "\" & FileName
    On Error GoTo 0
    Application.DisplayAlerts = False
    tWB.SaveAs FileName:=FilePath & "\" & FileName, FileFormat:=56
    Application.DisplayAlerts = True
     
'Sending email through outlook

    Set oApp = CreateObject("Outlook.Application")
    Set oMail = oApp.CreateItem(0)
    With oMail
        .To = Mailid
        .SentOnBehalfOfName = "TEMPLATE"
        .Subject = "Pārvadājumu Stopi " & " " & Date
        .Body = Body
        .Attachments.Add tWB.FullName
        .send
    End With
    
    MsgBox "  Pasts veiksmīgi nosūtīts!", vbInformation
                     
                     
'Delete the temporary file and restore screen updating
    
    tWB.ChangeFileAccess Mode:=xlReadOnly
    Kill tWB.FullName
    tWB.Close SaveChanges:=False
    cWB.Activate
    Application.ScreenUpdating = True
    Set oMail = Nothing
    Set oApp = Nothing
    
''ActiveSheet.PivotTables("PivotTable2").PivotFields("Rajons").CurrentPage = "all"

End Sub

Thanks for any help

moving up >>

anyone? I take any advice