Excel - Une macro pour trier plusieurs feuilles
Problème
J'ai 11 feuilles dans Excel. 10 feuilles doivent extraire des informations de la feuille1.
Ceci est pour les chefs d'un service de traiteur.
J'ai un mot clé dans la colonne A pour différencier chaque ligne d'information.
Ce dont j'ai besoin c'est ...
- Feuille 2 et 3 pour extraire la ligne complète de la feuille 1 si le mot de la colonne A est "Chaud".
- Feuille 4 et 5 pour tirer la ligne complète de la feuille 1 si le mot dans la colonne A est "Froid".
- Feuille 6 pour tirer la ligne complète de la feuille 1 si le mot dans la colonne A est "En vrac".
- Feuille 8 et 9 pour tirer la ligne complète de la feuille 1 si le mot dans la colonne A est "Pâtisserie".
- Feuille 10 pour extraire la ligne complète de la feuille 1 si le mot de la colonne A est "Pres".
Les autres feuilles sont déjà couvertes.
J'ai créé une macro pour trier les feuilles sur trois colonnes. Il serait bien que cette macro soit automatiquement exécutée chaque fois que des informations sont ajoutées à la feuille. Non pas sur une ligne mais sur une zone de la feuille pour garder les informations en ordre.
Solution
Essayez cette macro:
Option Explicit Private Sub Worksheet_Change (Plage ByVal en tant que plage) Dim nxtRow As Integer 'Déterminez si la modification a été apportée à la colonne H (8) Si Target.Column = 8 Alors' Si oui, Déterminez si cell = Hot Si Target.Value = "H" Alors 'Si oui, trouve la ligne vide suivante dans la feuille 2 nxtRow = Feuilles (2) .Range ("G" & Rows.Count) .End (xlUp) .Row + 1' Copier la ligne modifiée et la coller dans la feuille 2 Target.EntireRow .Copie _ Destination: = Feuilles (2) .Range ("A" & nxtRow) 'Si Oui, trouve la ligne vide suivante dans la feuille 3 nxtRow = Feuilles (3) .Range ("G" & Rows.Count) .Fin ( xlUp) .Row + 1 'Copier la ligne modifiée et le coller dans la feuille 3 Target.EntireRow.Copy _ Destination: = Sheets (3) .Range ("A" & nxtRow) End If End If "Déterminez si la modification a été appliquée à la colonne H ( 8) Si Target.Column = 8 Alors 'Si oui, Déterminez si cell = Froid Si Target.Value = "C" Puis "Si Oui, trouvez la ligne vide suivante dans la feuille 4 nxtRow = Sheets (4) .Range (" G " & Rows.Count) .End (xlUp) .Row + 1 'Copier la ligne modifiée et le coller dans la feuille 4 Target.EntireRow.Copy _ Destination: = Sheets (4) .Range ("A" & nxtRow)' Si Oui, trouvez rangée vide suivante dans la feuille 5 nxtRow = Feuilles (5) .Range ("G" & Rows.Count) .End (xlUp) .Row + 1 'Copier la ligne modifiée et le coller dans la feuille 3 Target.EntireRow.Copy _ Destination: = Sheets (5) .Range ("A" & nxtRow) End If End If "Déterminez si la modification a été apportée à la colonne H (8) Si Target.Column = 8 Alors" Si Oui, déterminez si cell = Presentation If Target.Value = " P "Puis" Si Oui, recherche la ligne vide suivante dans la feuille 8 nxtRow = Sheets (8) .Range ("G" & Rows.Count) .End (xlUp) .Row + 1 'Copier la ligne modifiée et la coller dans la feuille 8 cible .EntireRow.Copy _ Destination: = Sheets (8) .Range ("A" & nxtRow) End If End If "Détermine si la modification a été apportée à la colonne H (8) Si Target.Column = 8 Alors" Si oui, détermine si la cellule = Pastry If Target.Value = "PY" Alors 'Si oui, trouve la ligne vide suivante dans la feuille 10 nxtRow = Sheets (10) .Range ("G" & Rows.Count) .End (xlUp) .Row + 1' Copier ligne modifiée et coller dans la feuille 10 Target.EntireRow.Copy _ Destination: = Feuilles (10) .Range ("A" & nxtRow) 'Si Oui, trouve la ligne vide suivante dans la feuille 12 nxtRow = Feuilles (11) .Range (" G "& Rows.Count) .End (xlUp) .Row + 1 'Copier la ligne modifiée et le coller dans la feuille 12 Target.EntireRow.Copy _ Destination: = Feuilles (11) .Range ("A" & nxtRow) End If End If "Détermine si la modification a été apportée à la colonne H (8) Si Target.Column = 8 Alors 'Si Oui, Déterminez si cell = Bulk Si Target.Value = "B" Puis "Si Oui, trouvez la ligne vide suivante dans la feuille 6 nxtRow = Sheets (6) .Range (" G "& Rows.Count) .End (xlUp) .Row + 1 'Copier la ligne modifiée et le coller dans la feuille 6 Target.EntireRow.Copy _ Destination: = Sheets (6) .Range (" A "& nxtRow) End If End If End Sub Merci à Jlee1978 pour ce conseil.