macro extraire des données de tableaux dans des onglets différents

[akrillon]

Bonjour à tous,

Je suis sur un projet et je suis bloqué par mon niveau de programation

J'essaye d'extraire des données de tableaux répartie dans plusieurs onglets,
c'est à dire je définie une variable grâce à une liste déroulante et si (grace à une macro) excel trouve une même variable dans les différents tableaux il me ressort l'ensemble des informations qui sont sur cette ligne....

Bon c'est surement incompréhensible ^^, donc j'ai fait un petit excel exemple, à l'intérieur il y a le cas expliqué et les résultats de ma réflexion ( c'est pas très glorieux hein! mais j'apprend xD)

Merci d'avance à tous ceux qui voudrons bien me preter mains forte!

 

[Robert]

Re : macro extraire des données de tableaux dans des onglets différents

Bonsoir Akrillon, bonsoir le forum,

En pièce jointe ton fichier modifié. Plutôt que d'utiliser le bouton la macro, se lance à l'événement Change de l'onglet Récap. Tu choisis une valeur dans la cellule I5 et la macro de lance. Comme je ne savais pas si tu voulais conserver les données, au cas où tu sélectionnerais plusieurs valeurs à la suite, j'ai choisi de les effacer. Mais je t'ai indiqué dans la code la partie à supprimer si ça ne convenais pas...
Le code :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim VC As String 'décalre la variable VC (Valeur Cherchée)
Dim O As Object 'déclare la variable O (Onglet)
Dim R As Range 'déclare la variable R (Recherche)
Dim Dest As Range 'déclare la variable Dest (cellule de Destination)
Dim test As Boolean 'déclare la variable test

If Target.Address <> "$I$5" Then Exit Sub 'si le chamgement a lieu ailleurs qu'en I5, sort de la procédure
VC = CStr(Target.Value) 'définit la valeur cherchée VC

'**********************************************************************************************
'cette partie supprime d'éventuelles anciennes données. Supprime la si tu désires les conserver
With Sheets("Récap") 'prend en compte l'onglet "Récap"
    'si A2 n'est pas vide, efface toutes les lignes éditées à partir de la ligne 2
    If .Range("A2").Value <> "" Then .Range("A1").CurrentRegion.Offset(1, 0).Clear
End With 'fin de la prise en compte de l'onglet "Récap"
'**********************************************************************************************

For Each O In Sheets 'boucle sur tous les onglets du classeur
    'condition 1 : si le nom de l'onglet n'est ni "Data" ni "Récap"
    If Not O.Name = "Data" And Not O.Name = "Récap" Then
        Set R = O.Columns(1).Find(VC, , xlValues, xlWhole) 'de'finit la recherche R (Recherche VC dans la colonne 1 [=A] de l'onglet)
        If Not R Is Nothing Then 'condition 2 : si il existe au moins une occurrence trouvée
            'définit la cellule de destination Dest
            Set Dest = Sheets("Récap").Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0)
            R.Resize(1, 4).Copy Dest 'copie la cellule de l'occurrence trouvée redimensionné à 4 colonnes (de A à D)
            test = True 'définit la variable test
        End If 'fin de la condition 2
    End If 'fin de la condition 1
Next O 'prochain onglet de la boucle
'si la variable test est "Faux", message
If test = False Then MsgBox "Aucune ocurrencetrouvée pour : " & CStr(VC) & " !"
End Sub

Le Fichier :

 

[akrillon]

Re : macro extraire des données de tableaux dans des onglets différents

Bonjour Robert,

tout marche comme sur des roulette!
Je l'ai adapter à mon fichier et tout va bien
pour la suppression j'ai inséré un bouton qui permet de fiare un clear et tout va bien!

Merci beaucoup de ton aide!!!

 

[akrillon]

Re : macro extraire des données de tableaux dans des onglets différents

je viens de regarder plus en profondeur et il me manque toujours un truc ^^

Ce que tu as fais est génaile mais la recherche n'effectue qu'un "tour" par onglet
Or, une reference chercher peut revenir plusieurs fois dans le même onglet
est il possible d'avoir deux résultats, voir plus, par pages et pas comme actuellement un résultat par page?

 

[Robert]

Re : macro extraire des données de tableaux dans des onglets différents

Bonjour Akrillon, bonjour le forum,

J'y avait pensé mais un rapide coup d'œil sur ton fichier exemple m'avait fait opter pour un code simple. Je te modifie ça...

 

[Robert]

Re : macro extraire des données de tableaux dans des onglets différents

Bonjour Akrillon, bonjour le forum,

Le code modifié :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim VC As String 'décalre la variable VC (Valeur Cherchée)
Dim O As Object 'déclare la variable O (Onglet)
Dim R As Range 'déclare la variable R (Recherche)
Dim Dest As Range 'déclare la variable Dest (cellule de Destination)
Dim PA As String 'déclare la variable PA (Première Adresse)
Dim test As Boolean 'déclare la variable test

If Target.Address <> "$I$5" Then Exit Sub 'si le chamgement a lieu ailleurs qu'en I5, sort de la procédure
VC = CStr(Target.Value) 'définit la valeur cherchée VC

'**********************************************************************************************
'cette partie supprime d'éventuelles anciennes données. Supprime la si tu désires les conserver
With Sheets("Récap") 'prend en compte l'onglet "Récap"
    'si A2 n'est pas vide, efface toutes les lignes éditées à partir de la ligne 2
    If .Range("A2").Value <> "" Then .Range("A1").CurrentRegion.Offset(1, 0).Clear
End With 'fin de la prise en compte de l'onglet "Récap"
'**********************************************************************************************

For Each O In Sheets 'boucle sur tous les onglets du classeur
    'condition 1 : si le nom de l'onglet n'est ni "Data" ni "Récap"
    If Not O.Name = "Data" And Not O.Name = "Récap" Then
        Set R = O.Columns(1).Find(VC, , xlValues, xlWhole) 'de'finit la recherche R (Recherche VC dans la colonne 1 [=A] de l'onglet)
        If Not R Is Nothing Then 'condition 2 : si il existe au moins une occurrence trouvée
            PA = R.Address
            Do 'exécute
                'définit la cellule de destination Dest
                Set Dest = Sheets("Récap").Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0)
                R.Resize(1, 4).Copy Dest 'copie la cellule de l'occurrence trouvée redimensionné à 4 colonnes (de A à D)
                Set R = O.Columns(1).FindNext(R) 'redéfinit la recherche r (occurrence suivante)
            Loop While Not R Is Nothing And R.Address <> PA 'boucle tant qu'il existe de nouvelles occurrences ailleurs qu'en PA
            test = True 'définit la variable test
        End If 'fin de la condition 2
    End If 'fin de la condition 1
Next O 'prochain onglet de la boucle
'si la variable test est "Faux", message
If test = False Then MsgBox "Aucune ocurrencetrouvée pour : " & CStr(VC) & " !"
End Sub