Discussion :

[Sting]

Bonjour Forum,

J'aurai besoin d'un petit bout de code VBA pour trier plusieurs feuilles d'un classeur un peu gros.

Ci-joint

Je voudrai que le code VBA recherche dans l'ensemble des feuilles du classeur la condition "Rupture" et qu'en suite les cellules A, B,C et I de ces lignes en "Rupture" soient collées dans l'onglet Cde (en rouge) toujours dans le même classeur.

La Macro doit prendre en compte l'ensemble des feuilles du classeur, ainsi que toutes les lignes qui peuvent-être renseignées...

J'espère avoir été clair

J'ai essayé de créer un enregistrement Macro, mais celà ne donne rien, il manque des conditions ???

P.S. Données du tableau il n'y a rien de confidentiel c'est un projet qui se veut réaliste. De plus le projet joint est fortement réduit "Upload"

[jfontaine]

Ca devrait faire ce que tu veux.
Je te laisse ajouter le code qui remet a blanc la liste avant la recherche dans les feuilles

Code a coller dans la feuille Cde

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
 
Sub rupture()
 
Dim i As Long
Dim Idest As Long
 
Dim sh As Worksheet
 
Idest = 4
 
For Each sh In ThisWorkbook.Sheets
    i = 4
 
    Do While sh.Range("K" & i).Value <> ""
 
        If UCase(sh.Range("K" & i).Value) = "RUPTURE" Then
 
            Sheets("Cde").Range("A" & Idest).Value = sh.Range("A" & i).Value
            Sheets("Cde").Range("B" & Idest).Value = sh.Range("B" & i).Value
            Sheets("Cde").Range("C" & Idest).Value = sh.Range("C" & i).Value
            Sheets("Cde").Range("D" & Idest).Value = sh.Range("I" & i).Value
            Idest = Idest + 1
        End If
 
        i = i + 1
    Loop
 
Next sh
 
 
End Sub

[Sting]

Merci Jérome,

Ca fonctionne

Au risque de paraître lourd

Comme je débute en VBA pourrais-tu stp à coté des lignes VB m'indiquer en info le raisonnement ? Si tu as le Temps ...

De façon à ce que j'intègre le mécanisme de la Macro.

Encore Merci.

A+

[jfontaine]

Pas de problème

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
 
 
Sub rupture()
'Déclaration des variables 
Dim i As Long 'sert pour boucler sur les lignes de chaque feuille
Dim Idest As Long 'sert pour boucler sur les lignes d'insertion CDE
 
Dim sh As Worksheet 'Objet feuille
 
Idest = 4 'Pour commencer a inserer ligne 4
 
For Each sh In ThisWorkbook.Sheets 'pour chaque feuille du classeur
    i = 4 'on commence a chercher a partir de la ligne 4
 
    Do While sh.Range("K" & i).Value <> "" 'tant que je ne trouve pas une cellule vide (fin de fichier)
 
        'Ucase met le mot en majuscule
        If UCase(sh.Range("K" & i).Value) = "RUPTURE" Then
            'Ajout des données de la feuille en cours de traitement dans la feuille de destination
            Sheets("Cde").Range("A" & Idest).Value = sh.Range("A" & i).Value
            Sheets("Cde").Range("B" & Idest).Value = sh.Range("B" & i).Value
            Sheets("Cde").Range("C" & Idest).Value = sh.Range("C" & i).Value
            Sheets("Cde").Range("D" & Idest).Value = sh.Range("I" & i).Value
            Idest = Idest + 1
        End If
 
        i = i + 1
    Loop
 
Next sh
 
 
End Sub

[Sting]

Merci Jérome

A+ Le Forum