Code VBA pour un classeur assez lourd

Question

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"...

IBegin · Answer

Si j'ai bien compris ton problème, ça donnerait ça : Sub ReportFeuille() Dim don don = "Rupture" Dim jcom jcde = 4 Dim Nombre Nombre = Worksheets.Count Nombre = Nombre - 1 While Not Sheets("Cde").Cells(jcde, 1).Value = "" jcde = jcde + 1 Wend For numfeuil = 1 To Nombre Step 1 For i = 4 To 150 If Sheets(numfeuil).Cells(i, 11) = don Then Sheets("Cde").Cells(jcde, 1).Value = Sheets(numfeuil).Cells(i, 1).Value Sheets("Cde").Cells(jcde, 2).Value = Sheets(numfeuil).Cells(i, 2).Value Sheets("Cde").Cells(jcde, 3).Value = Sheets(numfeuil).Cells(i, 3).Value Sheets("Cde").Cells(jcde, 4).Value = Sheets(numfeuil).Cells(i, 9).Value jcde = jcde + 1 End If Next i Next numfeuil End Sub à insérer dans module1 par exemple. Sur le classeur BgCfdCallouProjet, ça marche A +...

IBegin · Answer

J'ai vu une petite erreur dans une déclaration de variable alors je reposte, avec des commentaires pour une meilleure compréhension

Sub ReportFeuille()

Dim don

don = "Rupture"

'coquille dans la version précédente !

Dim jcde

jcde = 4

'on défini le nombre de feuille de ton doc

Dim Nombre

Nombre = Worksheets.Count

'on enlève 1 car la dernière c'est la feuille de commande

Nombre = Nombre - 1

'on place un curseur sur la dernière cellule vide de commande

While Not Sheets("Cde").Cells(jcde, 1).Value = ""

jcde = jcde + 1

Wend

'on fait une boucle qui parcourt chaque feuille

Dim numfeuil

For numfeuil = 1 To Nombre Step 1

'et dans chaque feuille on parcour les 150 permières lignes à la recherche de Rupture

For i = 4 To 150

'si on trouve un rupture, on copie et on incrémente notre curseur jcde de 1 pour l'enregistrement suivant

If Sheets(numfeuil).Cells(i, 11) = don Then

Sheets("Cde").Cells(jcde, 1).Value = Sheets(numfeuil).Cells(i, 1).Value

Sheets("Cde").Cells(jcde, 2).Value = Sheets(numfeuil).Cells(i, 2).Value

Sheets("Cde").Cells(jcde, 3).Value = Sheets(numfeuil).Cells(i, 3).Value

Sheets("Cde").Cells(jcde, 4).Value = Sheets(numfeuil).Cells(i, 9).Value

jcde = jcde + 1

End If

Next i

Next numfeuil

'et voilà !

End Sub

A +