Trier selon 2 conditions

[COLOR="DarkSlateGray"][B]Sub ventiler()
Dim oDat, rDat, pDest, i As Long
   Me.Shapes.Item(2).Visible = False
   With Application: .ScreenUpdating = False: .Calculation = xlManual: End With
   pDest = Array(4, Array("Nord est", "H20:J29"), Array("Nord ouest", "B20:D29"), Array("Sud est", "H3:J12"), Array("Sud ouest", "B3:D12"))
   Sheets.Add Before:=ActiveSheet
   With Feuil1
      With .Range(.Cells(1, 5), .Cells(.Rows.Count, 1).End(xlUp))
         oDat = .Value
         .Sort Key1:=.Cells(1, 3), Order1:=xlAscending, Key2:=.Cells(1, 4), Order2:=xlDescending, Header:=xlYes, Orientation:=xlSortColumns
         .AutoFilter
         For i = 1 To pDest(0)
            .AutoFilter Field:=3, Criteria1:=pDest(i)(0)
            .SpecialCells(xlCellTypeVisible).Copy Destination:=ActiveSheet.Range("A1")
            With ActiveSheet
               .Columns("B:C").Delete Shift:=xlToLeft
               rDat = .Range("A2:C11").Value
               .Range("A1:C11").Value = Empty
            End With
            Me.Range(pDest(i)(1)).Value = rDat
         Next i
         .AutoFilter Field:=3
         .AutoFilter
         .Value = oDat
      End With
   End With
   Me.Shapes.Item(1).Visible = True
   With Application
      .DisplayAlerts = False: ActiveSheet.Delete: .DisplayAlerts = True
      .Calculation = xlAutomatic: .ScreenUpdating = True
   End With
End Sub

Sub rst()
   Me.Shapes.Item(1).Visible = False
   Me.Range("B3:D12, H3:J12, B20:D29, H20:J29").ClearContents
   Me.Shapes.Item(2).Visible = True
End Sub[/B][/COLOR]