XL 2016 Récupérer des informations sous conditions - VBA

[Tophe2]

Bonjour le forum,

je souhaiterai récupérer des informations de différents onglets en fonction de plusieurs conditions et de les regrouper dans un onglet ("Suivi").

Dans le fichier joint (extrait d'un gros fichier de plusieurs onglets) il y a 5 onglets 3 vont servir à la récolte des informations (AM-BAR-BARJ), les deux autres ne doivent pas passer dans le traitement (Suivi-MODELE) voilà ce que je cherche à faire sur les feuilles (AM-BAR-BARJ...) si dans la colonne F il y a une date (donc non vide ou de couleur verte ou rouge) je souhaite récupérer la ligne (colonne A à L) peut être plus à l'avenir, si colonne J il y a une date (donc non vide) pareil on récupère la ligne (colonne A à L) pour mettre les informations souhaitées dans la feuille "suivi".

Actuellement cela est fait manuellement (long) et dans la colonne A je reporte le nom de l'onglet et quand je reporte le tout sur le même onglet (suivi) je perd le nom de l'onglet de départ sauf en faisant un copier coller option "valeur"

Est il envisageable de pouvoir automatiser ce traitement (VBA ou autre) en sachant que j'ai plus 20 onglets mais la mise en forme est identique.
Je cherche également de mon côté mais pour l'instant pas évident pour moi.

merci par avance pour votre aide
cordialement
Christophe

 

[Robert]

Bonjour Tophe, bonjour le forum,

Essaie comme ça :

Sub Macro1()
Dim S As Worksheet 'déclare la variable S (Suivi)
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim I As Integer 'déclare la variable I (Incrément)
Dim PLV As Integer 'déclare la variable PLV (Première Ligne Vide)

Set S = Worksheets("Suivi") 'définit l'onglet S
For Each O In Worksheets 'boucle 1 : sur tous les onglets O du classeur
    Select Case O.Name 'agit en fonction du nom de l'onglet
        Case "Suivi", "MODELE" 'cas où rien ne se passe
        Case Else 'autres cas
            TV = O.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
            For I = 2 To UBound(TV, 1) 'boucle 2 : sur toutes les lignes I du tableau des valeurs (en partant de la seconde)
                If TV(I, 6) <> "" Or TV(I, 10) <> "" Then 'condition : si la donnée en colonne 6 (=> F) ou en colonne 10 (=>J) n'est pas vide
                    PLV = S.Cells(Application.Rows.Count, "A").End(xlUp).Row + 1 'définit la première ligne vide de la colonne A de l'onglet S
                    S.Cells(PLV, "A").Value = O.Name 'renvoie le nom de l'onglet dans la colonne A
                    O.Cells(I, "B").Resize(1, UBound(TV, 2) - 1).Copy S.Cells(PLV, "B") 'copie le restant de la ligne (quelle que soit le nombre de colonnes) à partir de la colonne B
                End If 'fin de la condition
            Next I 'prochaine ligne de la boucle 2
    End Select 'fin de l'acion en fonction du nom de l'onglet
Next O 'prochain onglet de la boucle 1
End Sub

 

[Tophe2]

Bonjour Robert,
Bonjour Le forum,

Super merci beaucoup pour ta proposition qui convient parfaitement à mon utilisation et les explications qui vont m'aider à avancer.

je souhaite vider la feuille suivi avant de lancer la macro puis je placer ce code au début, il existe certainement un code plus court !!

Sheets("Suivi").Select
Rows("2:1000").Select
Selection.Delete Shift:=xlUp

et je vais voir pour trier la colonne A par ordre alpha

Bonne Journée
christophe

 

[Robert]

Re,

La règle d'or en VBA c'est d'éviter autant que tu le peux les Select inutiles. Ils ne font que ralentir l'exécution du code et sont source de plantage.
Ton code est correct mais utilise 3 Select alors que Sheets("Suivi").Rows("2:1000").Delete Shift:=xlUp fait la même chose.

Ci-dessous, le premier code modifié avec l'effacement des anciennes données et le tri alphabétique de la colonne A (même si visiblement tes onglets étaient déjà triés par ordre alphabétique)...

Sub Macro1()
Dim S As Worksheet 'déclare la variable S (Suivi)
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim I As Integer 'déclare la variable I (Incrément)
Dim PLV As Integer 'déclare la variable PLV (Première Ligne Vide)

Set S = Worksheets("Suivi") 'définit l'onglet S
S.Range("A1").CurrentRegion.Offset(1, 0).EntireRow.Delete 'efface les lignes sauf la première dans l'onglet S
For Each O In Worksheets 'boucle 1 : sur tous les onglets O du classeur
    Select Case O.Name 'agit en fonction du nom de l'onglet
        Case "Suivi", "MODELE" 'cas où rien ne se passe
        Case Else 'autres cas
            TV = O.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
            For I = 2 To UBound(TV, 1) 'boucle 2 : sur toutes les lignes I du tableau des valeurs (en partant de la seconde)
                If TV(I, 6) <> "" Or TV(I, 10) <> "" Then 'condition : si la donnée en colonne 6 (=> F) ou en colonne 10 (=>J) n'est pas vide
                    PLV = S.Cells(Application.Rows.Count, "A").End(xlUp).Row + 1 'définit la première ligne vide de la colonne A de l'onglet S
                    O.Cells(I, "A").Resize(1, UBound(TV, 2)).Copy S.Cells(PLV, "A") 'copie la ligne (quel que soit le nombre de colonnes)
                    S.Cells(PLV, "A").Value = O.Name 'remplace la formule par le nom de l'onglet dans la colonne A
                End If 'fin de la condition
            Next I 'prochaine ligne de la boucle 2
    End Select 'fin de l'acion en fonction du nom de l'onglet
Next O 'prochain onglet de la boucle 1
S.Range("A1").CurrentRegion.Sort S.Range("A1"), xlAscending, Header:=xlYes 'tri alphabétique de la colonne A
End Sub

 

[Tophe2]

Bonjour Robert,
Bonjour le Forum,

Merci encore pour tes corrections et surtout tes explications, je vais mettre le code dans le fichier qui contient plus d'onglet.

Questions en cas d'évolution du fichier (pas prévu pour l'instant) :

Suis je limité sur le nombre d'onglet à ne pas traiter je viens d'en ajouter deux pas de problème.
Pour les conditions si je souhaite à l'avenir ajouter des conditions suis je limité à un certains nombre ?

Bonne Journée et encore merci
Christophe