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...
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.
Bonjour,
revoici votre fichier avec les macro,
est ce que ça convient ?
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