Sub Filtrer()
 Dim rng As Range
 Dim lastline As Long
 Dim Atraiter As Long
 'Pour sélectionner l'onglet source
 ThisWorkbook.Worksheets("Entrée").Activate
 Set rng = ActiveSheet.Range("A1").CurrentRegion
 rng.Select
 'Filtrer la sélection
 rng.AutoFilter Field:=16, Criteria1:="V"
 rng.AutoFilter Field:=18, Criteria1:="V"
 'Tester si la feuille est vide
 Set rng = rng.Offset(1, 0).Resize(rng.Rows.Count - 1, rng.Columns.Count)
 Atraiter = Application.WorksheetFunction.Subtotal(103, Range(rng.Columns(16).Address))
 If Atraiter > 0 Then
 'Copier la sélection filtrée vers la feuille cible
   With Worksheets("B2, Méd, Psy").ListObjects(1)
      .ListRows.Add
      y = .ListRows.Count
      rng.Copy Destination:=.ListColumns(1).DataBodyRange.Cells(y, 1)
   End With
  'Supprimer les lignes importées
   rng.Rows.EntireRow.Delete
  End If
  'Désactiver le filtre
  ActiveSheet.ShowAllData
  
 'Pour sélectionner l'onglet source
 Set rng = ActiveSheet.Range("A1").CurrentRegion
 rng.Select
 'Filtrer la sélection
 rng.AutoFilter Field:=16, Criteria1:="NV"
 'Tester si la feuille est vide
 Set rng = rng.Offset(1, 0).Resize(rng.Rows.Count - 1, rng.Columns.Count)
 Atraiter = Application.WorksheetFunction.Subtotal(103, Range(rng.Columns(16).Address))
 If Atraiter > 0 Then
 'Copier la sélection filtrée vers la feuille cible
   With Worksheets("NV").ListObjects(1)
      .ListRows.Add
      y = .ListRows.Count
      rng.Copy Destination:=.ListColumns(1).DataBodyRange.Cells(y, 1)
   End With
  'Supprimer les lignes importées
   rng.Rows.EntireRow.Delete
  End If
  'Désactiver le filtre
  ActiveSheet.ShowAllData
  
  'Pour sélectionner l'onglet source
 Set rng = ActiveSheet.Range("A1").CurrentRegion
 rng.Select
 'Filtrer la sélection
 rng.AutoFilter Field:=18, Criteria1:="NV"
 'Tester si la feuille est vide
 Set rng = rng.Offset(1, 0).Resize(rng.Rows.Count - 1, rng.Columns.Count)
 Atraiter = Application.WorksheetFunction.Subtotal(103, Range(rng.Columns(16).Address))
 If Atraiter > 0 Then
 'Copier la sélection filtrée vers la feuille cible
   With Worksheets("NV").ListObjects(1)
      .ListRows.Add
      y = .ListRows.Count
      rng.Copy Destination:=.ListColumns(1).DataBodyRange.Cells(y, 1)
   End With
  'Supprimer les lignes importées
   rng.Rows.EntireRow.Delete
  End If
  'Désactiver le filtre
  ActiveSheet.ShowAllData
  
  Call Partie2

End Sub

Sub Partie2()
 Dim rng As Range
 Dim lastline As Long
 Dim Atraiter As Long

'Pour sélectionner l'onglet source
 ThisWorkbook.Worksheets("B2, Méd, Psy").Activate
 Set rng = ActiveSheet.Range("A1").CurrentRegion
 rng.Select
 'Filtrer la sélection
 rng.AutoFilter Field:=24, Criteria1:="V"
 rng.AutoFilter Field:=25, Criteria1:="V"
 rng.AutoFilter Field:=26, Criteria1:="V"
 'Tester si la feuille est vide
 Set rng = rng.Offset(1, 0).Resize(rng.Rows.Count - 1, rng.Columns.Count)
 Atraiter = Application.WorksheetFunction.Subtotal(103, Range(rng.Columns(16).Address))
 If Atraiter > 0 Then
 'Copier la sélection filtrée vers la feuille cible
   With Worksheets("V").ListObjects(1)
      .ListRows.Add
      y = .ListRows.Count
      rng.Copy Destination:=.ListColumns(1).DataBodyRange.Cells(y, 1)
   End With
  'Supprimer les lignes importées
   rng.Rows.EntireRow.Delete
  End If
  'Désactiver le filtre
  ActiveSheet.ShowAllData
  
   'Pour sélectionner l'onglet source
 Set rng = ActiveSheet.Range("A1").CurrentRegion
 rng.Select
 'Filtrer la sélection
 rng.AutoFilter Field:=24, Criteria1:="NV"
 'Tester si la feuille est vide
 Set rng = rng.Offset(1, 0).Resize(rng.Rows.Count - 1, rng.Columns.Count)
 Atraiter = Application.WorksheetFunction.Subtotal(103, Range(rng.Columns(16).Address))
 If Atraiter > 0 Then
 'Copier la sélection filtrée vers la feuille cible
   With Worksheets("NV").ListObjects(1)
      .ListRows.Add
      y = .ListRows.Count
      rng.Copy Destination:=.ListColumns(1).DataBodyRange.Cells(y, 1)
   End With
  'Supprimer les lignes importées
   rng.Rows.EntireRow.Delete
  End If
  'Désactiver le filtre
  ActiveSheet.ShowAllData
  
 'Pour sélectionner l'onglet source
 Set rng = ActiveSheet.Range("A1").CurrentRegion
 rng.Select
 'Filtrer la sélection
 rng.AutoFilter Field:=25, Criteria1:="NV"
 'Tester si la feuille est vide
 Set rng = rng.Offset(1, 0).Resize(rng.Rows.Count - 1, rng.Columns.Count)
 Atraiter = Application.WorksheetFunction.Subtotal(103, Range(rng.Columns(16).Address))
 If Atraiter > 0 Then
 'Copier la sélection filtrée vers la feuille cible
   With Worksheets("NV").ListObjects(1)
      .ListRows.Add
      y = .ListRows.Count
      rng.Copy Destination:=.ListColumns(1).DataBodyRange.Cells(y, 1)
   End With
  'Supprimer les lignes importées
   rng.Rows.EntireRow.Delete
  End If
  'Désactiver le filtre
  ActiveSheet.ShowAllData
  
 'Pour sélectionner l'onglet source
 Set rng = ActiveSheet.Range("A1").CurrentRegion
 rng.Select
 'Filtrer la sélection
 rng.AutoFilter Field:=26, Criteria1:="NV"
 'Tester si la feuille est vide
 Set rng = rng.Offset(1, 0).Resize(rng.Rows.Count - 1, rng.Columns.Count)
 Atraiter = Application.WorksheetFunction.Subtotal(103, Range(rng.Columns(16).Address))
 If Atraiter > 0 Then
 'Copier la sélection filtrée vers la feuille cible
   With Worksheets("NV").ListObjects(1)
      .ListRows.Add
      y = .ListRows.Count
      rng.Copy Destination:=.ListColumns(1).DataBodyRange.Cells(y, 1)
   End With
  'Supprimer les lignes importées
   rng.Rows.EntireRow.Delete
  End If
  'Désactiver le filtre
  ActiveSheet.ShowAllData
  
End Sub