Re,
Ci-dessous une proposition à étudier.
Cdlt.
Option Explicit
Public Sub Filter_Data()
Dim wb As Workbook
Dim ws As Worksheet, ws2 As Worksheet
Dim lo As ListObject, lo2 As ListObject
Dim rng As Range, rng2 As Range
Application.ScreenUpdating = False
Set wb = ActiveWorkbook
Set ws = wb.Worksheets("Feuil1")
Set ws2 = wb.Worksheets("Feuil2")
ws2.Cells.Clear
With ws
If .Cells(1).ListObject Is Nothing Then
Set lo = .ListObjects.Add(xlSrcRange, .Cells(1).CurrentRegion, , xlYes)
Else
Set lo = .ListObjects(1)
End If
End With
If lo.ShowAutoFilter Then lo.AutoFilter.ShowAllData
lo.Range.AutoFilter Field:=23, Criteria1:="Released to market"
lo.Range.AutoFilter Field:=18, Criteria1:="<>Free deal"
With lo.AutoFilter.Range
On Error Resume Next
Set rng = .Offset(1).Resize(.Rows.Count - 1, .Columns.Count).SpecialCells(xlCellTypeVisible)
On Error GoTo 0
End With
If rng Is Nothing Then
MsgBox "Il n'y a pas de données à copier!...", vbInformation, "Information"
Else
Set rng2 = lo.AutoFilter.Range
rng2.SpecialCells(xlCellTypeVisible).Copy
ws2.Cells(1).PasteSpecial xlPasteValuesAndNumberFormats
Application.CutCopyMode = 0
End If
Set lo2 = ws2.ListObjects.Add(xlSrcRange, ws2.Cells(1).CurrentRegion, , xlYes)
End Sub