Copier lignes en fonction d'un mot dans différents onglets

Le 10/12/2019 à 00:41

Bonjour à tous,

Je cherche une méthode simple (je suis une vraie quiche sous Excel pour copier des lignes à partir de plusieurs onglets vers d'autres onglets en fonction de mots clés qui seraient toujours dans une même colonne...

Ex:

Onglet Elodie : les 3ème, 5éme et 7ème lignes contiennent à la colonne C3 le mot Violaine (parmi d'autres... Sophie, Ludivine, et Elisabeth)

Onglet Marie : les 2ème, 5éme et 9ème lignes contiennent à la colonne C3 le mot Sophie (parmi d'autres... Violaine, Ludivine, et Elisabeth)

Onglet Florent : les 4ème, 5éme et 7ème lignes contiennent à la colonne C3 le mot Violaine (parmi d'autres... Sophie, Ludivine, et Elisabeth)

En allant à l'onglet Violaine : moyennant un script (ou autre chose) je retrouve toutes les lignes contenant le mot Violaine à la 3ème colonne reportées des autres onglets

En allant à l'onglet Sophie : moyennant un script (ou autre chose) je retrouve toutes les lignes contenant le mot Sophie à la 3ème colonne reportées des autres onglets

Etc...

Merci 1000 fois à celui qui pourrait me dépanner!

A+

Wish

Le 11/12/2019 à 19:04

Salut Wish,

avec un fichier et des explications plus pointues, on pourra faire mieux...

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
'
Dim rCel As Range
Dim iRow%, sItem$
'
Application.ScreenUpdating = False
With Sh
    Set rCel = .Range("A:A").Find(what:="EXTRACT", lookat:=xlWhole, LookIn:=xlValues, searchdirection:=xlNext)
    If Not rCel Is Nothing Then
        iRow = rCel.Row
        .Range("A" & iRow + 1 & ":XFD" & .Range("A" & Rows.Count).End(xlUp).Row + 1).Value = ""
    Else
        iRow = .UsedRange.Rows.Count + 5
        .Cells(iRow, 1) = "EXTRACT"
    End If
    sItem = Sh.Name
    For x = 1 To Sheets.Count
        If Sheets(x).Name <> Sh.Name Then
            Set sWk = Worksheets(Sheets(x).Name)
            For y = 1 To sWk.Range("C" & Rows.Count).End(xlUp).Row
                If sWk.Cells(y, 3) = sItem Then
                    iRow = iRow + 1
                    .Rows(iRow).Value = sWk.Rows(y).Value
                End If
            Next
        End If
    Next
End With
Application.ScreenUpdating = True
'
End Sub

A+

7wish.xlsm (20.90 Ko)

Le 16/12/2019 à 15:17

Bonjour curulis57

Merci beaucoup pour votre réponse et désolé pour ma réponse tardive... avec les grèves, j'ai dû travailler de chez moi et je ne suis pas passé par le bureau.

Je vous mets en PJ un fichier Excel qui montre assez simplement ce que je souhaite...

Si je peux encore abuser de votre gentillesse

10essai-tableau-elodie.xlsx (50.66 Ko)

Le 16/12/2019 à 15:19

En ouvrant les 3 derniers onglets vous allez mieux comprendre la demande...

Merci encore

Le 17/12/2019 à 00:35

Salut Wish,

quelque chose comme ça?

Chaque activation de l'une des 3 dernières feuilles actualise l'affichage.

la couleur des onglets n'est pas obligatoire mais la programmation actuelle en tient compte donc, si cela ne te plaît pas... faudra recommencer !
la boucle s'attend aussi à voir ces 3 onglets en dernières positions.

Si tu ajoutes un autre onglet, de ce type ou de l'autre,

place-les là où la macro les attend ;
colore l'onglet "CHEF DECO" en COLORINDEX 43 ;
adapte le code ici

For x = 1 To Sheets.Count - 3

Un double-clic dans un de ces 3 onglets sur la ligne 1 provoque un tri du tableau selon le critère de la colonne cliquée.

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
'
If Sh.Tab.ColorIndex = 43 Then
    With Sh
        If Not Intersect(Target, .Range("A1:N1")) Is Nothing Then
            Cancel = True
            .Range("A1:O" & .Range("A" & Rows.Count).End(xlUp).Row).Sort key1:=.Range(Chr(64 + Target.Column) & 2), order1:=xlAscending, Orientation:=xlTopToBottom, Header:=xlYes
        End If
    End With
End If
'
End Sub

Voyons au prochain épisode si tout cela te convient ou s'il faut pousser l'automatisation, toujours possible.

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
'
Dim sWk As Worksheet
Dim iRow1%, iRow2%
'
If Sh.Tab.ColorIndex = 43 Then
    Application.ScreenUpdating = False
    With Sh
        sItem = .Name
        .Cells.Delete
        On Error Resume Next
        Sh.Rows(1).Value = Sheets(1).Rows(1).Value
        For x = 1 To Sheets.Count - 3
            Set sWk = Sheets(x)
            sWk.Range("A1:O" & sWk.Range("A" & Rows.Count).End(xlUp).Row).Sort key1:=sWk.Range("C2"), order1:=xlAscending, Orientation:=xlTopToBottom, Header:=xlYes
            iRow1 = sWk.Range("C:C").Find(what:=sItem, lookat:=xlWhole, LookIn:=xlValues, searchdirection:=xlNext).Row
            If iRow1 > 0 Then
                iRow2 = sWk.Range("C:C").Find(what:=sItem, lookat:=xlWhole, LookIn:=xlValues, searchdirection:=xlPrevious).Row
                iRowT = .Range("A" & Rows.Count).End(xlUp).Row + 1
                .Range("A" & iRowT & ":O" & iRowT + (iRow2 - iRow1)).Value = sWk.Range("A" & iRow1 & ":O" & iRow2).Value
            End If
        Next
        .Range("A1:O" & .Range("A" & Rows.Count).End(xlUp).Row).Borders.LineStyle = xlContinuous
        .Range("A1:O1").BorderAround Weight:=xlMedium
        .Range("A1:O1").Interior.ColorIndex = 15
        .Columns.AutoFit
        On Error GoTo 0
    End With
    Application.ScreenUpdating = True
End If
'
End Sub

A+

14wish.xlsm (62.17 Ko)

Le 17/12/2019 à 02:14

Wish a écrit :
Bonjour à tous,
Je cherche une méthode simple (je suis une vraie quiche sous Excel pour copier des lignes à partir de plusieurs onglets vers d'autres onglets en fonction de mots clés qui seraient toujours dans une même colonne...
Ex:
Onglet Elodie : les 3ème, 5éme et 7ème lignes contiennent à la colonne C3 le mot Violaine (parmi d'autres... Sophie, Ludivine, et Elisabeth)
Onglet Marie : les 2ème, 5éme et 9ème lignes contiennent à la colonne C3 le mot Sophie (parmi d'autres... Violaine, Ludivine, et Elisabeth)
Onglet Florent : les 4ème, 5éme et 7ème lignes contiennent à la colonne C3 le mot Violaine (parmi d'autres... Sophie, Ludivine, et Elisabeth)
En allant à l'onglet Violaine : moyennant un script (ou autre chose) je retrouve toutes les lignes contenant le mot Violaine à la 3ème colonne reportées des autres onglets
En allant à l'onglet Sophie : moyennant un script (ou autre chose) je retrouve toutes les lignes contenant le mot Sophie à la 3ème colonne reportées des autres onglets
Etc...
Merci 1000 fois à celui qui pourrait me dépanner!
A+
Wish

Ta base de données arrive en plusieurs onglets comme ca? ou bien est-ce que c'est un gros onglet que tu exploses deja pour avoir les onglets par personne?

si c'est un gros onglet qui fait la BDD alors il suffit de TCD,

Si c'est tous ces petits onglets, mais qu leur nombre est fixe, alors je te propose d'utiliser Power query pour agréger touts ces onglets, puis faire des TCD ou filtrer directement en plusieurs queries selon les mots clefs que tu cherches...

Le 17/12/2019 à 18:25

curulis57 a écrit :

Salut Wish,

quelque chose comme ça?

Chaque activation de l'une des 3 dernières feuilles actualise l'affichage.

la couleur des onglets n'est pas obligatoire mais la programmation actuelle en tient compte donc, si cela ne te plaît pas... faudra recommencer !
la boucle s'attend aussi à voir ces 3 onglets en dernières positions.

Si tu ajoutes un autre onglet, de ce type ou de l'autre,

place-les là où la macro les attend ;
colore l'onglet "CHEF DECO" en COLORINDEX 43 ;
adapte le code ici

For x = 1 To Sheets.Count - 3

Un double-clic dans un de ces 3 onglets sur la ligne 1 provoque un tri du tableau selon le critère de la colonne cliquée.

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
'
If Sh.Tab.ColorIndex = 43 Then
    With Sh
        If Not Intersect(Target, .Range("A1:N1")) Is Nothing Then
            Cancel = True
            .Range("A1:O" & .Range("A" & Rows.Count).End(xlUp).Row).Sort key1:=.Range(Chr(64 + Target.Column) & 2), order1:=xlAscending, Orientation:=xlTopToBottom, Header:=xlYes
        End If
    End With
End If
'
End Sub

Voyons au prochain épisode si tout cela te convient ou s'il faut pousser l'automatisation, toujours possible.

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
'
Dim sWk As Worksheet
Dim iRow1%, iRow2%
'
If Sh.Tab.ColorIndex = 43 Then
    Application.ScreenUpdating = False
    With Sh
        sItem = .Name
        .Cells.Delete
        On Error Resume Next
        Sh.Rows(1).Value = Sheets(1).Rows(1).Value
        For x = 1 To Sheets.Count - 3
            Set sWk = Sheets(x)
            sWk.Range("A1:O" & sWk.Range("A" & Rows.Count).End(xlUp).Row).Sort key1:=sWk.Range("C2"), order1:=xlAscending, Orientation:=xlTopToBottom, Header:=xlYes
            iRow1 = sWk.Range("C:C").Find(what:=sItem, lookat:=xlWhole, LookIn:=xlValues, searchdirection:=xlNext).Row
            If iRow1 > 0 Then
                iRow2 = sWk.Range("C:C").Find(what:=sItem, lookat:=xlWhole, LookIn:=xlValues, searchdirection:=xlPrevious).Row
                iRowT = .Range("A" & Rows.Count).End(xlUp).Row + 1
                .Range("A" & iRowT & ":O" & iRowT + (iRow2 - iRow1)).Value = sWk.Range("A" & iRow1 & ":O" & iRow2).Value
            End If
        Next
        .Range("A1:O" & .Range("A" & Rows.Count).End(xlUp).Row).Borders.LineStyle = xlContinuous
        .Range("A1:O1").BorderAround Weight:=xlMedium
        .Range("A1:O1").Interior.ColorIndex = 15
        .Columns.AutoFit
        On Error GoTo 0
    End With
    Application.ScreenUpdating = True
End If
'
End Sub

A+

Waouuu! Curulis57 c'est top!

C'est exactement ce qu'il me fallait comme base pour commencer à travailler convenablement!

Je ne suis pas sûr de comprendre même la moitié de ta macro mais elle fonctionne très bien.

Ca me donne envie de m'y mettre un peu plus sur Excel!

Merci infiniment.

Wish

Le 17/12/2019 à 18:28

Rrradassse a écrit :
Wish a écrit :
Bonjour à tous,
Je cherche une méthode simple (je suis une vraie quiche sous Excel pour copier des lignes à partir de plusieurs onglets vers d'autres onglets en fonction de mots clés qui seraient toujours dans une même colonne...
Ex:
Onglet Elodie : les 3ème, 5éme et 7ème lignes contiennent à la colonne C3 le mot Violaine (parmi d'autres... Sophie, Ludivine, et Elisabeth)
Onglet Marie : les 2ème, 5éme et 9ème lignes contiennent à la colonne C3 le mot Sophie (parmi d'autres... Violaine, Ludivine, et Elisabeth)
Onglet Florent : les 4ème, 5éme et 7ème lignes contiennent à la colonne C3 le mot Violaine (parmi d'autres... Sophie, Ludivine, et Elisabeth)
En allant à l'onglet Violaine : moyennant un script (ou autre chose) je retrouve toutes les lignes contenant le mot Violaine à la 3ème colonne reportées des autres onglets
En allant à l'onglet Sophie : moyennant un script (ou autre chose) je retrouve toutes les lignes contenant le mot Sophie à la 3ème colonne reportées des autres onglets
Etc...
Merci 1000 fois à celui qui pourrait me dépanner!
A+
Wish
Ta base de données arrive en plusieurs onglets comme ca? ou bien est-ce que c'est un gros onglet que tu exploses deja pour avoir les onglets par personne?
si c'est un gros onglet qui fait la BDD alors il suffit de TCD,
Si c'est tous ces petits onglets, mais qu leur nombre est fixe, alors je te propose d'utiliser Power query pour agréger touts ces onglets, puis faire des TCD ou filtrer directement en plusieurs queries selon les mots clefs que tu cherches...

Merci à toi aussi Rrradassse

On n'a pas eu vraiment le temps d'échanger, mais notre ami Curulis57 a été rapide comme l'éclaire

Merci en tout cas pour ta réponse!

Wish

Rechercher des sujets similaires à "copier lignes fonction mot differents onglets"