En VBA, ne sélectionner dans un tableau que les lignes avec un "F"

Le 29/10/2025 à 20:29

Bonsoir,

Dans le tableau TS "tabel1", j'aimerais que ne soient sélectionnées que les lignes dont la colonne "Sexe" contient un "F".

Vous savez comment modifier ce code VBA ?

Merci bcp, bonne soirée

Voici le "tabel1" dont j'ai masqué qqes éléments d'identité

image 
Sub Importer_Noms_Prenoms_tir_13_cibles()
     Dim d     As Object
     Dim i As Long, Lig_Dest As Long, arr, N
     Dim Nom As String, Prenom As String
     Dim cle

     Application.ScreenUpdating = False

     Set d = CreateObject("Scripting.Dictionary")
     d.comparemode = vbTextCompare
     With Range("tabel1").ListObject
          If .ListRows.Count > 0 Then
               arr = .DataBodyRange.Columns(2).Resize(, 3).Value2
               For i = 1 To UBound(arr)
                    d(arr(i, 1) & "|" & arr(i, 2) & "|" & arr(i, 3)) = Array(arr(i, 1), arr(i, 2), arr(i, 3))
               Next
          End If
     End With
     N = d.Count
     If N = 1 Then Dict("dummy") = Dict.items()(0)     'ajouter un "dummy" si le dictionaire n'a qu'un clé

     With Sheets("tir à 13 cibles")
          'enlever le mot de passe
          .Unprotect Password:="seb"
          Application.Calculation = xlManual
          With Range("Tabel13").ListObject
               If .ListRows.Count = 0 Then .ListRows.Add
               i = Application.Max(1, N)
               If .ListRows.Count > i Then .DataBodyRange.Offset(i).Resize(.ListRows.Count - i).Delete
               If N > 0 Then .DataBodyRange.Resize(N).Value = Application.Index(d.items, 0, 0)
               With .Range
                    .Sort .Range("A1"), xlAscending, , .Range("B1"), xlAscending, Header:=xlYes
               End With
          End With
          Application.Calculation = xlCalculationAutomatic
          .Calculate
          .Protect "seb"
     End With
End Sub
Le 29/10/2025 à 23:15

quelque chose comme ceci (donc vous donnez la plage que vous voulez filtrer, puis de la 4ième colonne de cette plage seulement les "F")

range("Tabel1").listobject.range.autofilter 4,"F"

Je ne vois pas le "tabel1" dans la macro que vous nous montrez.

Le 30/10/2025 à 06:27

Bonjour Bart' et merci beaucoup...

J'ai eu une erreur de protection de la page, j'ai donc mis un unprotect et après ==>

J'ai une petite erreur de syntaxe :

image

Bonne journée...

à bientôt...

Le 30/10/2025 à 09:28

re,

en supposant qu'il y a un TS dans cette feuille qui s'appèle "TBL2_de_13_Cibles" (à modifier à ton goût), j'ai crée une macro paramétrée "Sub Importer_Noms_Prenoms(LO_Dest As ListObject)" que tu peux lancer comme tu peux voir dans la macro "Importer_Tir13".

Si cela fonctionne, tu peux utiliser la même macro pour les 2 autres feuilles.

Sub Importer_Tir13()
     Importer_Noms_Prenoms Range("TBL2_de_13_Cibles").ListObject     'lancer cette macro avec ce TS comme variable
End Sub

Sub Importer_Noms_Prenoms(LO_Dest As ListObject)

     Dim bEE   As Boolean, i

     Application.ScreenUpdating = False

     With LO_Dest                            'TS destination
          .Parent.Unprotect "seb"            'enlever protection de sa feuille
          On Error Resume Next
          .Parent.AutoFilter.Range.AutoFilter     'enlever flter éventuellement
          On Error GoTo 0
          If .ListRows.Count > 0 Then        'TS n'est pas vide, alors demander pour le vider
               Beep
               If vbYes = MsgBox("ce TS n'est pas vide" & vbLf & "Vider encore ?" & vbLf & vbLf & "Attention, OUI = Vider", vbYesNo, UCase(.Name)) Then
                    .DataBodyRange.Delete    'vider
               End If
          End If
     End With

     With Range("tabel1").ListObject         'TS source
          .Parent.Unprotect "seb"            'enlever protection de sa feuille
          On Error Resume Next
          .Parent.AutoFilter.Range.AutoFilter     'enlever filtre eventuel
          On Error GoTo 0
          .Range.AutoFilter 2, "<>"          'filtrer les noms "non-vides"
          .Range.AutoFilter 4, "F"           'filtrer les femmes
          bEE = Application.EnableEvents     'drapeau pour savoir l'état de "EnableEvents" à ce moment (VRAI ou FAUX)
          If bEE Then Application.EnableEvents = False     'si le drapeau est VRAI, alors temporairement mettre les events en FAUX
          i = .ListColumns("Nom").Range.SpecialCells(xlVisible).Count     'nombre de cellules visibles de la colonne Nom, entête inclu
          If i > 1 Then                      'plus qu'une cellule, entête inclu, donc il y a des femmes avec nom "non-vide" à copier
               .ListColumns("Nom").DataBodyRange.Resize(, 3).SpecialCells(xlVisible).Copy LO_Dest.ListRows.Add.Range     'copier 3 colonnes (nom,prenom,sexe) de ces femmes
               With LO_Dest                  'TS destination
                    .Range.RemoveDuplicates Array(1, 2, 3), Header:=xlYes     'supprimer les doublons
                    With .Range
                         .Sort .Range("A1"), xlAscending, .Range("B1"), , xlAscending, Header:=xlYes     'trier nom&prenom
                    End With
               End With
          End If
          If bEE Then Application.EnableEvents = True     'si le drapeau est VRAI, alors remettre les events dans l'état original (=TRUE)
          LO_Dest.Parent.Protect "seb"       'réinstaller protection dans la feuille de la destination
          .Range.AutoFilter                  'enlever filtre dans le source
          .Parent.Protect "seb"              'réinstaller protection dans la feuille du source
     End With

End Sub
Le 30/10/2025 à 16:31

Bonsoir Bart' et super idée, j'adore

Juste j'ai besoin que la ligne ==>

.Range.AutoFilter 4, "F"           'filtrer les femmes
Ne fonctionne que que la feuille "tir à 13 cibles"
Car pour les 2 autres feuilles, je prends les hommes et les femmes.
Est-ce-que je peux écrire la sub Importer_Tir13() comme ça ?
Sub Importer_Tir13()
     Importer_Noms_Prenoms Range("TBL2_de_13_Cibles").ListObject     'lancer cette macro avec ce TS comme variable
     .Range.AutoFilter 4, "F"           'filtrer les femmes
End Sub

Et j'enlèverai cette ligne là, la sub principale (importer_noms_prénoms)... Qu'en penses-tu ? C'est bon ou c'est bon ?

Merci.

à+ Bart'

Le 31/10/2025 à 09:57

Bonjour,

Il me semble que c'est un peu "Never ending story" votre fichier .
Bon trêve de plaisanterie...Mon intervention dans le fil n'a rien à voir avec votre demande dans ce fil qui est d'ailleurs suivie par BsAlv.

En consultant les sujets ici --> https://forum.excel-pratique.com/liste/sujets-sans-reponse, je vois que vous avez toujours 6 fils ouverts qui sont restés sans réponse suite à votre demande d'aide.
Pouvez-vous me dire si ces demandes sont toujours non résolues ou si on peut les supprimer.

Cordialement

Le 31/10/2025 à 10:11

re, salut Dan, on utilise un 2ième paramètre, le sexe

Sub Importer_Tir13()
     'option 1 = tout le monde
     Importer_Noms_Prenoms Range("TBL2_de_13_Cibles").ListObject     'lancer cette macro avec ce TS comme variable
     'option 2 = les femmes
     Importer_Noms_Prenoms Range("TBL2_de_13_Cibles").ListObject, "F"     'lancer cette macro avec ce TS comme variable
     'option 3 = les hommes
     Importer_Noms_Prenoms Range("TBL2_de_13_Cibles").ListObject, "H"     'lancer cette macro avec ce TS comme variable
     'option 4 = le 3ième gender ;-)
     Importer_Noms_Prenoms Range("TBL2_de_13_Cibles").ListObject, "X"     'lancer cette macro avec ce TS comme variable
     '
End Sub

Sub Importer_Noms_Prenoms(LO_Dest As ListObject, Optional sSexe As String)

     Dim bEE   As Boolean, i

     Application.ScreenUpdating = False

     With LO_Dest                            'TS destination
          .Parent.Unprotect "seb"            'enlever protection de sa feuille
          On Error Resume Next
          .Parent.AutoFilter.Range.AutoFilter     'enlever flter éventuellement
          On Error GoTo 0
          If .ListRows.Count > 0 Then        'TS n'est pas vide, alors demander pour le vider
               Beep
               If vbYes = MsgBox("ce TS n'est pas vide" & vbLf & "Vider encore ?" & vbLf & vbLf & "Attention, OUI = Vider", vbYesNo, UCase(.Name)) Then
                    .DataBodyRange.Delete    'vider
               End If
          End If
     End With

     With Range("tabel1").ListObject         'TS source
          .Parent.Unprotect "seb"            'enlever protection de sa feuille
          On Error Resume Next
          .Parent.AutoFilter.Range.AutoFilter     'enlever filtre eventuel
          On Error GoTo 0
          .Range.AutoFilter 2, "<>"          'filtrer les noms "non-vides"
          If Len(sSexe) Then .Range.AutoFilter 4, sSexe     'filtrer le sexe
          bEE = Application.EnableEvents     'drapeau pour savoir l'état de "EnableEvents" à ce moment (VRAI ou FAUX)
          If bEE Then Application.EnableEvents = False     'si le drapeau est VRAI, alors temporairement mettre les events en FAUX
          i = .ListColumns("Nom").Range.SpecialCells(xlVisible).Count     'nombre de cellules visibles de la colonne Nom, entête inclu
          If i > 1 Then                      'plus qu'une cellule, entête inclu, donc il y a des femmes avec nom "non-vide" à copier
               .ListColumns("Nom").DataBodyRange.Resize(, 3).SpecialCells(xlVisible).Copy LO_Dest.ListRows.Add.Range     'copier 3 colonnes (nom,prenom,sexe) de ces femmes
               With LO_Dest                  'TS destination
                    .Range.RemoveDuplicates Array(1, 2, 3), Header:=xlYes     'supprimer les doublons
                    With .Range
                         .Sort .Range("A1"), xlAscending, .Range("B1"), , xlAscending, Header:=xlYes     'trier nom&prenom
                    End With
               End With
          End If
          If bEE Then Application.EnableEvents = True     'si le drapeau est VRAI, alors temporairement remettre les events dans l'état original (=TRUE)
          LO_Dest.Parent.Protect "seb"       'réinstaller protection dans la feuille de la destination
          .Range.AutoFilter                  'enlever filtre dans le source
          .Parent.Protect "seb"              'réinstaller protection dans la feuille du source
     End With

End Sub
Le 31/10/2025 à 19:18

Bonsoir Bart' et merci beaucoup :-)

Hihihihi pour l'option 3

Bonsoir Dan ==> Oui on peut tout supprimer sauf les 4 derniers sujets, stp Et j'adore la musique de ce film "l'histoire sans fin". Je ne dirais pas que mon classeur est sans fin mais plutôt en recherche de perfection et d'évolution

Bart', en lançant la macro, on a plusieurs fois le message "Attention, OUI=Vider" qui s'affiche et parfois, au bout d'un moment, le tableau finit par se vider...

image

MAis quand l'importation se réalise, ma MFC est modifiée et une formule se créée automatiquement ==> =ET(PDF=""...

image

MErci Bart'

Bonne soirée

Le 01/11/2025 à 09:07

re, si tu choisis la feuille entière au lieu du tableau dans le menu déroulant en haut de ce gestionnaire des MFCs tu verras une vingtaine de MFCs avec plusieurs doublons, je le sais, Excel fait un bordelle avec ses MFCs. Ce que tu peux faire ..., mais commences avec au moins 2 lignes dans les 2 TS de ta feuille

  • Sélectionnes les lignes entières de 4-200(ou plus jusqu'à 1.048.000+) et puis dans le ruban, pour les MFCs, tu supprimes toutes les MFCs de la plage sélectionnée.
  • maintenant tous ces doublons sont disparus et il y a encore 8 MFCs, je suppose, si "PDF" est encore là, que celle avec "PDF" est inutile et tu la supprimes aussi.
  • ce qui me surprenait c'est qu'il y a encore des lignes vertes dans cette feuille et ce n'étaient pas les MFCs qui étaient la cause, donc tu supprime aussi toutes les surlignements à partir de la ligne 3 (maintenant) à 200 (ou plus), pour que ce sont que les MFCs qui font les différences.
  • puis pour chaque TS, indépendent, tu sélectionne sa première ligne, copie (CTRL+C) et tu colles "spécial" les "formats" vers le reste du TS

Bon, maintenant tes MFCs sont "nettoyées", mais c'est possible, surtout quand tu insères/supprimes des lignes au début ou au milieu dans tes TS qu'Excel ajoutera de nouveau des doublons et que tu devras répéter cette manipulation le mois/année prochain. Ces doublons ne causent pas des problèmes, donc ce n'est pas grave mais quand ils sont nombreux, ils ralentissent Excel. Je ne pense pas qu'Excel a créé cette MFC avec "PDF"

Pour cette histoire de "vider", il faut clicquer sur "oui" ou "non" oubien utiliser le bouton "Enter", ce qui est égal à "oui", donc c'était ce dernier cas ?

Le 01/11/2025 à 09:15

Bonjour Bart' et merci beaucoup pour toutes tes explications...

Je vais suivre chaque étape, une à une

Juste j'ai un message quand je clique sur "Importer Liste..." qui s'affiche ==> "Attention, OUI=Vider" qui s'affiche mais quand je mets "Oui", rien ne se vide et le même message réapparaît et parfois, au bout de plusieurs validations, le tableau finit par se vider...

image
Le 01/11/2025 à 09:23

re,

je te réponse cette après-midi ..., je dois m'en aller ...

Le 01/11/2025 à 09:33

oui bien sûr, merci beaucoup pour ta précieuse aide

Bonne journée

Rechercher des sujets similaires à "vba selectionner tableau que lignes"