Macro d'extraction de ligne suivant valeur sur une colonne.

DRILL

XLDnaute Occasionnel
Bonjour a tous,

Je cherche a faire une macro pour extraire (copie) les lignes suivant le contenu de leur cellule en colonne "E".

Exemple si en feuille "Report Past" la celulle en colonne "E" contient "IA" extraction de la ligne en feuille "IA List"
La ligne de titre doit etre reprise dans chaque feuille "IA List" "OV List"...etc.

Pour info je ne peux pas utiliser de macro avec fonction filtre car suivant l'importation en feuille "Report Past" certaines valeurs (IA, OV...) n'existent pas.

Fichier test joint

Slts
DRILL
 

Pièces jointes

  • TEST Inventory Transaction Values 1.xls
    192.5 KB · Affichages: 127

Robert

XLDnaute Barbatruc
Repose en paix
Re : Macro d'extraction de ligne suivant valeur sur une colonne.

Bonsoir Drill, bonsoir le forum,

En pièce jointe ton fichier modifié avec la macro ci-dessous :
Code:
Sub Macro1()
Dim pl As Range 'déclare la variable pl (PLage)
Dim cel As Range 'déclare la variable cel (CELlule)
Dim dest As Range 'déclare la variable dest (DESTination)
Dim o As Worksheet 'déclare la variable o (Onglet)
 
With Sheets("Report Past") 'prend en compte l'onglet "Report Past"
    Set pl = .Range("E2:E" & .Range("E2").End(xlDown).Row) 'de'finit la plage pl
End With 'fin de la prise en compte l'onglet "Report Past"
 
For Each cel In pl 'boucle sur toutes les cellules cel de la plage pl
    On Error Resume Next 'gestion des erreurs, si une erreur est générée passe à la ligne suivante
    'prend en compte l'onglet indiqué dans cel (génère une erreur si l'onglet n'existe pas)
    With Sheets(cel.Value & " List")
        If Err > 0 Then 'condition : si une erreur est générée
            Err = 0 'annule l'erreur
            Sheets.Add 'ajoute un nouvel onglet
            ActiveSheet.Name = cel.Value & " List" 'nomme l'onglet
            Sheets("Report Past").Rows("1:1").Copy 'copie la première ligne
            'colle la largeur des colonne
            ActiveSheet.Range("A1").PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
                SkipBlanks:=False, Transpose:=False
            'colle les valeurs
            ActiveSheet.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
            ActiveSheet.Range("A2").Select 'sélectionne la cellule A2
            ActiveSheet.Move Before:=Sheets("RESULTS") 'place le nouvel onglet avant l'onglet Resuslt
        End If 'fin de la condition
        On Error GoTo 0 'annule la gestion des erreurs
    End With 'fin de la prose en compte de l'onglet indiqué dans cel
    Set o = Sheets(cel & " List") 'définit l'onglet o
    'définit la cellule de destination
    Set dest = o.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0)
    cel.EntireRow.Copy dest 'copie et colle la ligne dans la cellule de destination
Next cel 'prochaine cellule cel de la boucle
End Sub
 

Pièces jointes

  • Drill_v01.xls
    172 KB · Affichages: 330

DRILL

XLDnaute Occasionnel
Re : Macro d'extraction de ligne suivant valeur sur une colonne.

Robert,

Les bras m'en tombent... les explications de la macro en plus.. que du bonheur.

Le fait de generer les onglets en fonctions des valeurs est un plus car cela me permet de controler d'eventuelles transactions autres que IA, II, IW, PI, OV et OG.

Grand merci a toi.
DRILL
 

DRILL

XLDnaute Occasionnel
Re : Macro d'extraction de ligne suivant valeur sur une colonne.

Robert, Tous,

Je cherche a inserer une ligne dans le code de Robert pour stopper la macro si la feuille "Report Past" est vide..
Car si par erreur l'utilisateur final de ce fichier lance la macro avant d'avoir importe les donnees... ca tourne en boucle un bon moment.

Merci
DRILL
 

Grand Chaman Excel

XLDnaute Impliqué
Re : Macro d'extraction de ligne suivant valeur sur une colonne.

Bonsoir Drill,

En supposant qu'il y a obligatoirement une valeur dans la colonne E, tu pourrais faire une simple vérification sur la cellule E2 :

VB:
With Sheets("Report Past") 'prend en compte l'onglet "Report Past"
    If .Range("E2") = "" Then MsgBox "Erreur de données!":   Exit Sub  'vérifie si onglet valide
    Set pl = .Range("E2:E" & .Range("E2").End(xlDown).Row) 'de'finit la plage pl
End With 'fin de la prise en compte l'onglet "Report Past"

A+
 

MolitobeVIII

XLDnaute Nouveau
Bonjour,

Je suis tombé sur ce poste, cela m'a beaucoup aidé.

J'aurais une demande :
Si l'on change des données de l'onglet principal, comment faire pour que les données mises à jour le soit aussi dans les onglets créés par la macro?
Actuellement si je rajoute des données dans l'onglet principal et que je relance la macro, elle me copie en doublon les données déjà existantes en plus des nouvelles données.

Merci de votre aide.
 

Discussions similaires

Réponses
8
Affichages
431

Statistiques des forums

Discussions
312 488
Messages
2 088 867
Membres
103 979
dernier inscrit
imed