Excel VBA création tableau sous conditions

Résolu/Fermé
Dario - 19 janv. 2012 à 14:05
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 - 20 janv. 2012 à 08:28
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

A voir également:

2 réponses

pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 743
19 janv. 2012 à 14:56
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
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
C'est top!
Grand merci pour ton aide précieuse.
0
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
pijaku Messages postés 12263 Date d'inscription jeudi 15 mai 2008 Statut Modérateur Dernière intervention 4 janvier 2024 2 743
20 janv. 2012 à 08:28
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