Excel VBA création tableau sous conditions

Résolu
Dario -  
pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   -
Bonjour,

je me permets à mon tour d'exposer mon problème.

Je travaille sur un fichier excel composé de 6 feuilles. Chaque feuille correspond à un sous ensemble d'une machine.
Chaque sous ensemble est composé de pièces (une pièce par ligne) et chaque pièce a 5 paramètres (colonne 1=désignation; colonne 2= n°; colonne 3 = statut; colonne 4 = kilométrage).

Je cherche à présent à créer une autre feuille "entretien" avec la démarche suivante
- pour chaque sous-ensemble, sélectionner les pièces dont le statut est "HS"
- insérer chaque pièce hs dans la feuille "entretien" mais uniquement avec les paramètres désignation, n° et kilométrage (colonnes A, B et D).

J'ai essayé toutes sortes de méthode disons "bricolés" mélangeant, des boucles Si, Tant que etc mais je ne m'en sort pas.

Si une personne plus experte que moi aurait la gentillesse de me mettre sur la voie je lui en serait très reconnaissant.

D'avance merci beaucoup.
Dario

2 réponses

  1.
    pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
     
    Bonjour,
    Il te faut :
    1- parcourir toutes les feuilles du classeur: 
    Dim Wsh As WorkSheet
For Each Wsh In ThisWorkBook.WorkSheets

    1a- exclure la feuille nommée "Entretien" : 
    If Wsh.Name = "Entretien" Then
'on fait rien
Else
'ici le code de "on fait quelque chose"

    ou plus simplement : 
    If Wsh.Name <> "Entretien" Then

    2- on parcourt les colonnes C (toujours sur chaque feuille...)
    2a- en déterminant au préalable la dernière ligne remplie de la colonne C : 
    Dim DernLigne As Long 
DernLigne = Wsh.Range("C" & Rows.Count).End(xlUp).Row

    2b- en bouclant sur toutes les lignes de cette colonne C, si on trouve "HS" alors... 
    Dim Lig As Long
For Lig = 2 To DernLigne
    If Wsh.Cells(Lig, 3).Value = "HS" Then
        'blabla
    End If
Next

    3- Si on a "HS" en C on copie colle les colonnes A, B et D en feuille "Entretien", colonnes A, B, C, dans la première ligne vide
    3a- première ligne vide colonne A feuille Entretien : 
    Dim LigVide As Long
With Sheets("Entretien")
    LigVide = .Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row
End With
Wsh.Range("A" & Lig).Copy Sheets("Entretien").Range("A" & LigVide)
Wsh.Range("B" & Lig).Copy Sheets("Entretien").Range("B" & LigVide)
Wsh.Range("D" & Lig).Copy Sheets("Entretien").Range("C" & LigVide)


    Ce qui nous donne un code : 
    Dim Wsh As Worksheet
Dim DernLigne As Long
Dim Lig As Long
Dim LigVide As Long

For Each Wsh In ThisWorkbook.Worksheets
    If Wsh.Name <> "Entretien" Then
        DernLigne = Wsh.Range("C" & Rows.Count).End(xlUp).Row
        For Lig = 2 To DernLigne
            If Wsh.Cells(Lig, 3).Value = "HS" Then
                With Sheets("Entretien")
                    LigVide = .Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row
                End With
                Wsh.Range("A" & Lig).Copy Sheets("Entretien").Range("A" & LigVide)
                Wsh.Range("B" & Lig).Copy Sheets("Entretien").Range("B" & LigVide)
                Wsh.Range("D" & Lig).Copy Sheets("Entretien").Range("C" & LigVide)
            End If
        Next Lig
    End If
Next Wsh

    Si beaucoup de données (+ de 5000 / feuille), dis le ...
    1
    1. Dario
       
      Bonjour Pijaku,
      merci beaucoup pour ces indications.
      Je vais essayer et revenir vers le forum pour mon verdict (réussi ou problèmes).
      Mes feuilles font maximum 100 lignes et j'ai 6 feuilles à synthétiser.

      Encore merci!
      Cdlt.
      0
    2. Dario
       
      C'est top!
      Grand merci pour ton aide précieuse.
      0
    3. Dario
       
      Juste une dernière question, si pour la colonne D je veux juste copier la valeur retournée par la case? (et non la formule?).
      J'ai essayé en ajoutant .Value et une égalité mais ça ne fonctionne pas...
      Merci.
      0
  2. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
     
    Bonjour,
    Pour cela, dans le code donné plus haut, remplace : 
    Wsh.Range("D" & Lig).Copy Sheets("Entretien").Range("C" & LigVide)

    par : 
    Sheets("Entretien").Range("C" & LigVide) = Wsh.Range("D" & Lig).Value

    Tout simplement, au lieu de copier la cellule, on dit que les valeurs sont égales...
    0