Filtrer des données sur plusieurs feuilles par mots clés et copie de ligne

Bonjour,

J'ai un fichier excel qui comprend plusieurs informations et qui est partagé entre plusieurs personnes. Ce document ressemble à un tableau de bord qui comprend un Grantt divisé par thème (un thème par feuille). Une personne peut avoir plusieurs actions à réaliser.

Pour cela, je souhaiterais savoir s'il est possible à partir de la feuille SOMMAIRE pour une personne (par exemple Mme Y) de connaitre l'action avec le délai, et le critère de son action en tapant son nom.

J’espère ne pas m'être trop mal exprimée, je vous joint un fichier exemple pour une meilleure compréhension,

Je vous remercie par avance

NB: Je ne sais pas vraiment faire de VBA, je viens de découvrir...

17exemple.xlsx (228.20 Ko)

Bonjour,

Pour cela, je souhaiterais savoir s'il est possible à partir de la feuille SOMMAIRE pour une personne (par exemple Mme Y) de connaitre l'action avec le délai, et le critère de son action en tapant son nom.

Pourriez-vous montrer le résultat attendu ?

Merci pour votre réponse, je vous met le fichier en pièce jointe ou j'ai inscris quelques commentaires.

15exemple.xlsx (214.61 Ko)

Bonjour,

revoici votre fichier avec les macro,

est ce que ça convient ?

27ceci1e-exemple1.xlsm (225.04 Ko)
Sub trouve()
Dim keywords As String, c As Range, arrF, f
Set sh = Sheets("Sommaire")
arrF = Array("Plantes", "Animaux")

rw = sh.Cells(Rows.Count, "C").End(xlUp).Row + 1
sh.Range("A25:P" & rw).ClearContents
sh.Range("G25:P" & rw).Interior.ColorIndex = xlNone

Set plg = Range("J:J")

For i = LBound(arrF) To UBound(arrF)
  keywords = sh.Range("D6")
  rw = sh.Cells(Rows.Count, "C").End(xlUp).Row + 1
  With Sheets(arrF(i))
     With .Range("J:J")

    Set c = .Find(keywords, LookIn:=xlValues, LookAt:=xlPart)
    If Not c Is Nothing Then
        firstRW = c.Row

        sh.Cells(rw, 3) = firstRW
        sh.Cells(rw, 4) = Sheets(arrF(i)).Name
        sh.Cells(rw, 5) = Sheets(arrF(i)).Cells(c.Row, 4)
        sh.Cells(rw, 6) = Sheets(arrF(i)).Cells(c.Row, 9)
        For y = 1 To 12
         sh.Cells(rw, 6 + y).Interior.Color = Sheets(arrF(i)).Cells(c.Row, 11 + y).Interior.Color
        Next

        Do

            Set c = .FindNext(c)
            If c.Row = firstRW Then GoTo suivant
            rw = sh.Cells(Rows.Count, "C").End(xlUp).Row + 1
            sh.Cells(rw, 3) = c.Row
            sh.Cells(rw, 4) = Sheets(arrF(i)).Name
            sh.Cells(rw, 5) = Sheets(arrF(i)).Cells(c.Row, 4)
            sh.Cells(rw, 6) = Sheets(arrF(i)).Cells(c.Row, 9)
            For y = 1 To 12
             sh.Cells(rw, 6 + y).Interior.ColorIndex = Sheets(arrF(i)).Cells(c.Row, 11 + y).Interior.ColorIndex
            Next

        Loop While Not c Is Nothing And c.Row <> firstRW
    End If
   End With
  End With
suivant:
Next
End Sub

Bonjour,

C'est exactement ça!!! trop fort!!

Je viens de commencer des cours de VBA, c'est possible de vous demander de m'expliquer un peu ce qui est écrit?

Sans vouloir abuser...

Je vous remercie beaucoup!!

Bonjour,

C'est exactement ça!!! trop fort!!

Je viens de commencer des cours de VBA, c'est possible de vous demander de m'expliquer un peu ce qui est écrit?

Je ne suis pas très doué pour commenter, alors j'espère que ceci pourra tous de même vous être utile,

si le problème est résolu, s.v.p. pour clôturer le fil, cliquer sur le bouton V vert du post à coté du bouton EDITER, merci!

Sub trouve()
'déclaration des variables
Dim keywords As String, c As Range, arrF, f
Set sh = Sheets("Sommaire")
arrF = Array("Plantes", "Animaux")
'dernière ligne de la colonne "C" sur l'onglet "Sommaire"
rw = sh.Cells(Rows.Count, "C").End(xlUp).Row + 1
'effacer les données de l'onglet "Sommaire"
sh.Range("A25:P" & rw).ClearContents
'effacer les formats de l'onglet "Sommaire"
sh.Range("G25:P" & rw).Interior.ColorIndex = xlNone

'boucle sur les onglets "Plantes" et "Animaux"
For i = LBound(arrF) To UBound(arrF)
  'nom chercher
  keywords = sh.Range("D6")
'  rw = ligne ou sera inscrit les données trouvées
  rw = sh.Cells(Rows.Count, "C").End(xlUp).Row + 1

  With Sheets(arrF(i)) ' au premier tour de la boucle arrF(i) = "Plantes"
     With .Range("J:J")

    'recherche le nom inscrit sur  Sommaire!D6
    Set c = .Find(keywords, LookIn:=xlValues, LookAt:=xlPart) 'on devrait mettre xlWhole à la place de xlPart
    If Not c Is Nothing Then  'si trouvé affecter le numéro de ligne à la variable firstRW
        firstRW = c.Row
        'inscrire les valeur trouvées sur l'onglet "Sommaire"
        sh.Cells(rw, 3) = firstRW
        sh.Cells(rw, 4) = Sheets(arrF(i)).Name
        sh.Cells(rw, 5) = Sheets(arrF(i)).Cells(c.Row, 4)
        sh.Cells(rw, 6) = Sheets(arrF(i)).Cells(c.Row, 9)
        'mettre la couleur sur l'onglet "Sommaire"
        For y = 1 To 12
         sh.Cells(rw, 6 + y).Interior.Color = Sheets(arrF(i)).Cells(c.Row, 11 + y).Interior.Color
        Next

        ' la suite dépend de FindNext, le prochain trouvé on fait la même chose
        Do

            Set c = .FindNext(c)
'            si la ligne trouvé = la première trouvée, passe à suivant (suivant est soit boucler i sur "Animaux" ou end sub)
            If c.Row = firstRW Then GoTo suivant
            rw = sh.Cells(Rows.Count, "C").End(xlUp).Row + 1
            sh.Cells(rw, 3) = c.Row
            sh.Cells(rw, 4) = Sheets(arrF(i)).Name
            sh.Cells(rw, 5) = Sheets(arrF(i)).Cells(c.Row, 4)
            sh.Cells(rw, 6) = Sheets(arrF(i)).Cells(c.Row, 9)
            For y = 1 To 12
             sh.Cells(rw, 6 + y).Interior.ColorIndex = Sheets(arrF(i)).Cells(c.Row, 11 + y).Interior.ColorIndex
            Next
         'faire tant que la ligne du prochain trouvé est différent de la ligne firstRW
        Loop While Not c Is Nothing And c.Row <> firstRW
    End If
   End With
  End With
suivant:
Next i
End Sub

Bonjour,

J'ai récupéré ce fichier car il correspond à mes besoins. Mon seul souci c'est que j'ai plusieurs onglets et je n'ai pas besoin de filtrer dans tous les onglets comment puis je intégrer dans la programmation l'exclusion de fichier

( j'ai essayé de mettre "Select Case ActiveSheet.Name

Case "T1", "T2", "T3"

Exit Sub) je ne suis pas du tout sure.

.d'autre part pour faire plus joli et faciliter la lecture, le tableau qui est extrait je souhaiterai réaliser un quadrillage par contre chaque tableau a un nombre de ligne différent : est ce possible ?

Je vous mets un exemple. Pour autant mon fichier a 54 onglets dont la moitié soit les onglets "T" sont à exclure

merci

21copie-p1-copie.xlsm (228.84 Ko)
Rechercher des sujets similaires à "filtrer donnees feuilles mots cles copie ligne"