Excel VBA selection lignes avec condition

Bonsoir,

Je suis en train de travailler sur une macro similaire. Pour répondre à ta dernière question, oui, c'est normal qu'Excel copie toutes les lignes (même celles cachées par le filtre), ça m'est déjà arrivé. Et si c'est un bug, moi ça m'arrive souvent...

Voilà, alors j'ai un tableau avec:
- premiere colonne vide
- 2e colonne : Nom
- 3e colonne : Prénom
- 4e colonne : sexe
- 5e colonne : age

je veux copier les monsieurs dans une autre feuille de calcul et les dames de même dans une 3eme feuille de calcul (il faut que ces 2 feuilles de calcul existent déjà, tu peux les rajouter à la main, ou bien ajouter du code au début pour les créer). Les noms de mes feuilles de calcul sotn sheet1, sheet2 et sheet3.

voici mon code (certainement possible de l'améliorer) il faut le compléter avec le rajout des en-têtes de colonnes mais le principe est là :

Sub CreationOnglets()

' COPIE DES LIGNES DESIREES DANS LES FEUILLES DE CALCUL DEDIEES

Dim Rw As Range
Dim Ligne As Long

' Sélectionne l'ensemble des données (utile pour qu'Excel ne "réfléchisse" pas sur les 65000 lignes)

Sheets("Sheet1").Select
ActiveCell.SpecialCells(xlLastCell).Select
Range(Selection, Cells(1)).Select

' Boucle qui va passer sur chaque ligne de la sélection afin de déterminer si des lignes contiennent le flag voulu
' puis copie dans une deuxième feuille de calcul

For Each Rw In Selection.Rows

Ligne = Rw.Row

If Rw.Cells(1, 4).Value = "M" Then
Rw.Copy Destination:=Worksheets("Sheet2").Cells(Ligne, 1).EntireRow
End If

Next Rw

' Boucle qui va passer sur chaque ligne de la sélection afin de déterminer si des lignes contiennent le flag voulu
' puis copie dans une troisième feuille de calcul

For Each Rw In Selection.Rows

Ligne = Rw.Row

If Rw.Cells(1, 4).Value = "F" Then
Rw.Copy Destination:=Worksheets("Sheet3").Cells(Ligne, 1).EntireRow
End If

Next Rw

' Supression des lignes vierges dans les feuilles de calcul récemment constituées

Sheets("Sheet2").Activate

With ActiveSheet.UsedRange
derLi = .Row + .Rows.Count - 1
End With
Application.ScreenUpdating = False
For r = derLi To 1 Step -1
If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete
Next r

Application.StatusBar = "- 20% - Macro en cours d'exécution, merci de patienter."

Sheets("Sheet3").Activate

With ActiveSheet.UsedRange
derLi = .Row + .Rows.Count - 1
End With
Application.ScreenUpdating = False
For r = derLi To 1 Step -1
If Application.CountA(Rows(r)) = 0 Then Rows(r).Delete
Next r

' Pop-up d'avertissement de fin de macro.

MsgBox "Le fichier est prêt pour envoi. Veuillez effectuer un test de cohérence avant envoi.", vbOKOnly, "Macro terminée"

End Sub