Extraction par type d'éléments

Bonjour,

Je ne sais pas si la question a été posée dans les 85000 sujets, du coup je me permets de demander. Le titre est compliqué, mais ce que je veux faire est plutôt simple. J'ai un fichier excel, avec 3 feuilles:

  • 1 feuille synthèse
  • 1 feuille garçon
  • 1 feuille fille

Dans la feuille synthèse j'ai:

colonne A: le sexe

colonne B: le nom

colonne C: l'âge

colonne D: l'activité sportive

Et ce que je voudrais c'est que dans la feuille garçon:

n'avoir que les informations relatives aux garçons. Donc en gros les mêmes colonnes que la feuille synthèse mais qu'avec les garçons.

Pareil pour la feuille fille.

Et au final quand j'ajoute un garçon ou une fille de plus (dans la feuille synthèse), ça s'ajoute automatiquement dans la bonne feuille (garçon ou fille).

Comment est ce possible?

Merciiiiiiiiiiiiiii

Salut SamSam,

oh, peut-être pas 85.000 fois mais pas loin...

Tu encodes tes protégés uniquement depuis ta feuille Synthèse ou selon ton humeur, directement dans les bonnes feuilles?

C'est très simple mais as-tu quand même un fichier à nous présenter, histoire que tu prennes tout de suite de bonnes habitudes?

A+

Voici mon fichier simplifié:

Cependant je le fais à la main l'ajout des filles et des garçons sur les feuilles concernées... Ce qui est une galère!

Bonjour le fil, bonjour le forum,

Essaie comme ça :

Sub Macro1()
Dim S As Worksheet 'déclare la variable S (onglet Synthèse)
Dim G As Worksheet 'déclare la variable G (onglet garçon)
Dim F As Worksheet 'déclare la variable F (onglet Fille)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Byte 'déclare la variable J (incrément)
Dim KG As Integer 'déclare la variable KG (incrément Garçon)
Dim KF As Integer 'déclare la variable S (incrément Fille)
Dim TG() As Variant 'déclare la variable TG (Tableau Garçon)
Dim TF() As Variant 'déclare la variable TF (Tableau Fille)

Set S = Worksheets("Synthèse") 'définit l'onglet S
TV = S.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
Set G = Worksheets("Garçons") 'définit l'onglet G
Set F = Worksheets("Filles") 'définit l'onglet F
G.Cells.ClearContents 'efface le contenu de l'onglet G
F.Cells.ClearContents 'efface le contenu de l'onglet F
G.Range("A1").Resize(1, 4) = Application.Index(TV, 1) 'renvoie dans la cellule A1 redimensionnée de l'onglet G les en-têtes du tableau des valeurs TV
F.Range("A1").Resize(1, 4) = Application.Index(TV, 1) 'renvoie dans la cellule A1 redimensionnée de l'onglet F les en-têtes du tableau des valeurs TV
KG = 1 'initialise la variable KG
KF = 1 'initialise la variable KF
For I = 2 To UBound(TV, 1) 'boucle 1 : sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    If UCase(TV(I, 1)) = "M" Then 'si la valeur de la donnée ligne I colonne 1 de TV (convertie en majuscule) est égale à "M"
        ReDim Preserve TG(1 To 4, 1 To KG) 'redimensionne le tableau des gaçons TG (4 lignes, K colonnes)
        For J = 1 To 4 'boucle 2 : sur les 4 colonnes du tableau des valeurs TV
            TG(J, KG) = TV(I, J) 'récupère dans la ligne J de TG, la valeur de la données colonne J de TV (= Transposition)
        Next J 'prochaine colonne de la boucle 2
        KG = KG + 1 'incrémente KG (ajoute une colonne au tableau des garçons TG)
    ElseIf UCase(TV(I, 1)) = "F" Then 'si la valeur de la donnée ligne I colonne 1 de TV (convertie en majuscule) est égale à "F"
        ReDim Preserve TF(1 To 4, 1 To KF) 'redimensionne le tableau des filles TF (4 lignes, K colonnes)
        For J = 1 To 4 'boucle 2 : sur les 4 colonnes du tableau des valeurs TV
            TF(J, KF) = TV(I, J) 'récupère dans la ligne J de TF, la valeur de la données colonne J de TV (= Transposition)
        Next J 'prochaine colonne de la boucle 2
        KF = KF + 1 'incrémente KF (ajoute une colonne au tableau des filles TF)
    End If 'fin de la condition
Next I 'prochaine ligne de la boucle 1
'si KG est supéieure à 1, renvoie dans la cellule A2 redimensionnée de l'onglet G le tableau TG transposé
If KG > 1 Then G.Range("A2").Resize(UBound(TG, 2), 4).Value = Application.Transpose(TG)
'si KF est supéieure à 1, renvoie dans la cellule A2 redimensionnée de l'onglet F le tableau TF transposé
If KF > 1 Then F.Range("A2").Resize(UBound(TF, 2), 4).Value = Application.Transpose(TF)
End Sub

Lance la macro chaque fois que tu rajoutes une ou plusieurs données dans l'onglet Synthèse...

bonjour

un essai sans VBA ; pret pour plus de 220 filles ou garçons

6samsam88.xlsx (22.96 Ko)

cordialement

Salut SamSam,

Bonsoir ThauThème, Tulipe,

une autre voie, encore. Tant que les chemins mènent à Rome, c'est bon!

Ici, tu te contentes de compléter ta ligne de données. Une fois complète, l'onglet 'Filles' ou 'Garçons' s'actualise tout seul.

En prime, pour chaque onglet, en cliquant sur l'en-tête d'une colonne au choix, les données s'y trient selon la colonne, te permettant une consultation aisée des données de tes ouailles en fonction de différents critères.

Private Sub Worksheet_Change(ByVal Target As Range)
'
Dim wksG, wksF, wksS As Worksheet
'
Set wksG = Worksheets("Garçons")
Set wksF = Worksheets("Filles")
'
Application.EnableEvents = False
'
iLig = Target.Row
If Cells(iLig, 1) <> "" And Cells(iLig, 2) <> "" And Cells(iLig, 3) <> "" And Cells(iLig, 4) <> "" Then
    Range("A" & iLig & ":D" & iLig).Borders.LineStyle = 1
    Set wksS = IIf(UCase(Cells(iLig, 1)) = "M", wksG, wksF)
    With wksS
        iRow = .Cells(Rows.Count, 1).End(xlUp).Row + 1
        .Range("A" & iRow & ":D" & iRow).Value = Range("A" & iLig & ":D" & iLig).Value
        .Range("A" & iRow & ":D" & iRow).Borders.LineStyle = 1
        .Range("A2:D" & iRow).Sort key1:=.Range("B2"), order1:=xlAscending
    End With
End If
'
Application.EnableEvents = True
'
End Sub

A+

Rechercher des sujets similaires à "extraction type elements"