Transfert colonne vers une autre feuille selon condition

Bonjour à tous,

J'espère que vous allez bien !

Je cherche à copier la colonne B de toutes les feuilles (11) (sauf les feuilles Bdd et IMAGE_DROIT) vers la feuille IMAGE_DROIT s'il y a inscrit Oui dans la colonne J (de chaque feuille)

J'ai réussi à copier la colonne B mais je ne sais pas où placer ma condition. J'ai placé ma macro dans ThisWorkbook (Général) et je l'affecterai à un bouton + tard

Sub transfert()
'Macro pour recopier les colonnes dans la feuille Droit_Image
Dim dlgR As Integer, dlgi As Integer
Dim i As Byte
With Sheets("DROIT_IMAGE")
dlgR = .Range("A" & Rows.Count).End(xlUp).Row
.Range("B3:B" & dlgR).ClearContents ' colonne à copier
End With
For i = 1 To Worksheets.Count
If Sheets(i).Name <> "Bdd" And Sheets(i).Name <> "DROIT_IMAGE" Then
        dlgR = Sheets("DROIT_IMAGE").Range("A" & Rows.Count).End(xlUp).Row
        With Sheets(i)
            dlgi = .Range("A" & Rows.Count).End(xlUp).Row
            .Range("B3:B" & dlgi).Copy ' colonne à copier
            Sheets("DROIT_IMAGE").Range("A" & dlgR + 1).PasteSpecial xlPasteValues 'endroit ou copier
        End With
    End If

Next
End Sub

J'espère que quelqu'un aura une idée

Merci d'avance

Edit: J'ai oublié de préciser qu'il faudrait ignorer les données déjà transférées et copier dans la feuille" Droit à l'image" à la suite.

Bonsoir

Vos feuilles1 à 11 contenant chacune un tableau au format structuré, essayez avec ce code..

Sub transfert()
'Macro pour recopier les colonnes dans la feuille Droit_Image
Dim dlgR As Integer ', dlgi As Integer
Dim i As Byte, k As Byte, j As Byte
Dim tablo()

Sheets("DROIT_IMAGE").Range("B:B").ClearContents ' colonne à copier

For i = 1 To Worksheets.Count
    If Sheets(i).Name <> "Bdd" And Sheets(i).Name <> "DROIT_IMAGE" Then
        With Sheets(i)
            k = 0
            For j = 1 To .ListObjects(1).ListRows.Count
                If UCase(.ListObjects(1).DataBodyRange(j, 10)) = "OUI" Then
                    ReDim Preserve tablo(k)
                    tablo(k) = .ListObjects(1).DataBodyRange(j, 2)
                    k = k + 1
                End If
            Next j

            If k > 0 Then
                With Sheets("DROIT_IMAGE")
                    dlgR = .Range("B" & Rows.Count).End(xlUp).Row + 1
                    .Range("B" & dlgR).Resize(UBound(tablo) + 1) = Application.Transpose(tablo)
                End With
            End If
        End With
    End If
Next i
End Sub

Si ok et terminé pensez à

Cordialement

Merci Dan

J'ai enlevé ce morceau car je dois garder les données copiées 5 ans.

 Sheets("DROIT_IMAGE").Range("B:B").ClearContents 

Comment faire pour que les données qui ont déjà été copiées 1 fois ne le soient pas à nouveau dès que je lance la macro ?

Est-ce possible de rajouter dans la colonne A de la feuille DROIT_IMAGE, le nom de la feuille d'où les données ont été transféré ?

Merciiii

Re

Comment faire pour que les données qui ont déjà été copiées 1 fois ne le soient pas à nouveau dès que je lance la macro ?

Heu je n'ai pas compris là. Pourquoi supprimez-vous les données de la colonne B au début du code ? Le code supprime les données de la colonne et reprend tout ce qui est avec Oui.

Est-ce possible de rajouter dans la colonne A de la feuille DROIT_IMAGE, le nom de la feuille d'où les données ont été transféré ?

Oui c'est possible. Il faut revoir le code...
Dites moi si vous voulez d'autres choses à importer depuis les feuilles hormis le nom des feuilles et salarié

Oui c'est possible. Il faut revoir le code...

Désolé ! Je n'y ai pensé qu'après . Il n'y a que ces 2 infos là.

Heu je n'ai pas compris là. Pourquoi supprimez-vous les données de la colonne B au début du code ? Le code supprime les données de la colonne et reprend tout ce qui est avec Oui.

Non justement je ne veux pas que les données importées dans la feuille DROIT_IMAGE soient supprimées si elles ont déjà été copiées ^^. C'est parce que lorsque le salarié est parti je supprime sa ligne dans les autres feuilles mais j'ai besoin de garder l'information dans droit à l'image.

Non justement je ne veux pas que les données importées dans la feuille DROIT_IMAGE soient supprimées .....

Remplacez tout le code par celui ci-dessous

Sub transfert2()
'Macro pour recopier les colonnes dans la feuille Droit_Image
Dim dlgR As Integer ', dlgi As Integer
Dim i As Byte, k As Byte, j As Byte
Dim tablo()

For i = 1 To Worksheets.Count
    If Sheets(i).Name <> "Bdd" And Sheets(i).Name <> "DROIT_IMAGE" Then
        With Sheets(i)

            ReDim tablo(.ListObjects(1).ListRows.Count, 1)
            k = 0

            For j = 1 To .ListObjects(1).ListRows.Count
                If UCase(.ListObjects(1).DataBodyRange(j, 10)) = "OUI" Then
                    On Error Resume Next
                    lig = WorksheetFunction.Match(.ListObjects(1).DataBodyRange(j, 2).Value, Sheets("DROIT_IMAGE").Range("B:B"), 0)
                    On Error GoTo 0
                    If lig = 0 Then
                        tablo(k, 0) = Sheets(i).Name
                        tablo(k, 1) = .ListObjects(1).DataBodyRange(j, 2)
                        k = k + 1
                    End If
                End If
            Next j

            If k > 0 Then
                With Sheets("DROIT_IMAGE")
                    dlgR = .Range("B" & Rows.Count).End(xlUp).Row + 1
                    For j = 0 To UBound(tablo)
                        .Range("A" & dlgR) = tablo(j, 0)
                        .Range("B" & dlgR) = tablo(j, 1)
                        dlgR = dlgR + 1
                    Next j
                End With
            End If
        End With
    End If
Next i
End Sub

Crdlt

Bonjour Dan,

Merci pour le code. Concernant le nom de la feuille ça fonctionne.

Lorsque je saisie des nouvelles données et déclenche la macro, les nouvelles données ne se transfèrent pas.

J'ai l'impression que l'action a été faite une fois et lorsque je clique plus rien ne se passe.

Lorsque je saisie des nouvelles données et déclenche la macro, les nouvelles données ne se transfèrent pas.

est-ce que le nom des salariés peuvent être identiques d'une feuille à l'autre ?

non car lors des mutations je supprime la ligne pour la passer sur la nouvelle feuille mais par contre dans la feuille image il pourrait y avoir 2x.

non car lors des mutations je supprime la ligne pour la passer sur la nouvelle feuille mais par contre dans la feuille image il pourrait y avoir 2x.

Je ne suis pas sûr d'avoir compris
Ma question était de savoir si en fait un nom pouvait se trouver une fois sur la feuille 1 et un autre fois sur la feuille 3
Si ce n'est pas le cas (donc il n'y a pas de doublons de noms dans les feuilles), je ne comprends pas le souci que vous mentionnez

A moins que ce soit pour mentionner un nom qui était la feuille 1 et qui est supprimé de la feuille 1 pour passer en feuille 3 ?[s=co-c0504d][/s]

Navré d'avoir du mal à m'expliquer !

J'ai lancé la macro, les données se sont bien transférées.

Lorsque j'ai saisi un nouveau salarié (par exemple dans la feuille 3) avec un droit à l'image=Oui et que je lance à nouveau la macro, la nouvelle donnée ne se transfère pas dans la feuille DROIT_IMAGE.

Il n'y aura pas de doublon en temps réel dans les feuilles 1 à 11 mais un salarié qui était en feuille 2, peut se retrouver en feuille 4. (il aura été effacé manuellement de la feuille 2)

Est-ce que c'est plus compréhensible

Edit : Là vous voulez avoir les deux infos. Une fois le nom mentionné en feuille 1 et une fois le nom mentionné en feuille 3 (puisque mutation)

Oui je veux laisser les 2 informations dans la feuille DROIT_IMAGE

Lorsque j'ai saisi un nouveau salarié (par exemple dans la feuille 3) avec un droit à l'image=Oui et que je lance à nouveau la macro, la nouvelle donnée ne se transfère pas dans la feuille DROIT_IMAGE.

Oui c'est parce que la variable "lig" vérifie que le nom du salarié est présent dans la feuille Droit_image. Du coup s'il existe déjà cela ne transfère pas

Il n'y aura pas de doublon en temps réel dans les feuilles 1 à 11 mais un salarié qui était en feuille 2, peut se retrouver en feuille 4. (il aura été effacé manuellement de la feuille 2)

Ok. en dessous de la ligne --> lig = WorksheetFunction.Match......, rajoutez cette ligne

If lig > 0 And Sheets("DROIT_IMAGE").Range("A" & lig) <> Sheets(i).Name Then lig = 0

Lorsque je clique plusieurs fois sur la macro alors que je n'ai fait aucun changement il répète à l'infini la dernière donnée transférée.

Par contre, lorsque je change la condition en Oui sur une des feuilles, la macro ne transfère pas cette nouvelle donnée. C'est possible que la macro refasse la vérification de la condition ?

Oui c'est parce que la variable "lig" vérifie que le nom du salarié est présent dans la feuille Droit_image. Du coup s'il existe déjà cela ne transfère pas

C'était des nouveaux noms qui n'étaient dans aucune feuille. Actuellement lorsque je rajoute une ligne en fin de tableau d'une feuille et que je mets la condition "Oui", il n'y aucun transfert. J'ai essayé d'insérer une ligne dans le tableau (et non à la fin) c'est la même chose.

edit : et aussi lorsque j'ai fait 1 fois le transfert et que je reviens sur une feuille changer la condition, le nouveau transfert ne se fait pas

edit 2 : lorsque j'ai fait un changement de condition dans la feuille 1 et lancé la macro, ça a fonctionné

et aussi lorsque j'ai fait 1 fois le transfert et que je reviens sur une feuille changer la condition, le nouveau transfert ne se fait pas

Ok on va changer le code car au final on peut réenregistrer tout ce que vous avez dans les feuilles et supprimer tout simplement le doublons puisque on aura toutes les infos une deuxième fois en colonne A et B
Pour être sûr,
- est-ce que cette feuille Droit image comporte d'autres informations ?
- Avez-vous un titre en ligne 1 pour les deux colonnes ?

- est-ce que cette feuille Droit image comporte d'autres informations ?

Non

- Avez-vous un titre en ligne 1 pour les deux colonnes ?

Oui

Ok on va changer le code car au final on peut réenregistrer tout ce que vous avez dans les feuilles et supprimer tout simplement le doublons puisque on aura toutes les infos une deuxième fois en colonne A et B

Lorsque le salarié quitte l'entreprise je supprime la ligne concernée dans la feuille concernée (1 à 11) mais je dois garder sa ligne dans la feuille DROIT_IMAGE (5 ans)

Re

Essayez le code comme ceci plutôt

Sub transfert()
'Macro pour recopier les colonnes dans la feuille Droit_Image
Dim dlgR As Integer ', dlgi As Integer
Dim i As Byte, k As Byte, j As Byte
Dim tablo()

For i = 1 To Worksheets.Count
    If Sheets(i).Name <> "Bdd" And Sheets(i).Name <> "DROIT_IMAGE" Then
        With Sheets(i)
            ReDim tablo(.ListObjects(1).ListRows.Count, 1)
            k = 0
            For j = 1 To .ListObjects(1).ListRows.Count
                If UCase(.ListObjects(1).DataBodyRange(j, 10)) = "OUI" Then
                        tablo(k, 0) = Sheets(i).Name
                        tablo(k, 1) = .ListObjects(1).DataBodyRange(j, 2)
                        k = k + 1
                End If
            Next j

            If k > 0 Then
                With Sheets("DROIT_IMAGE")
                    dlgR = .Range("B" & Rows.Count).End(xlUp).Row + 1
                    For j = 0 To UBound(tablo)
                        .Range("A" & dlgR) = tablo(j, 0)
                        .Range("B" & dlgR) = tablo(j, 1)
                        dlgR = dlgR + 1
                    Next j
                End With
            End If
        End With
    End If
Next i

With Sheets("DROIT_IMAGE")
    dlgR = .Range("B" & Rows.Count).End(xlUp).Row
    .Range("A2:B" & dlgR).RemoveDuplicates Columns:=Array(1, 2), Header:=xlNo
End With
End Sub

Bonjour Dan,

J'ai cette erreur :

Lorsque je rajoute une ligne dans un tableau et met la condition oui, il me recopie tous les salariés qui sont notés oui et pas simplement la nouvelle ligne.

Oui c'est parce que la variable "lig" vérifie que le nom du salarié est présent dans la feuille Droit_image. Du coup s'il existe déjà cela ne transfère pas

S'il est présent, est-ce qu'il peut ne pas faire le transfert ? (nom + feuille identique ?)

Bonjour

J'ai cette erreur :

Je ne sais vous dire avec cette erreur, il faut savoir sur quelle ligne cela bugue. Elle devrait être soulignée en jaune. Sinon cela peut provenir du nom d'une feuille

Lorsque je rajoute une ligne dans un tableau et met la condition oui, il me recopie tous les salariés qui sont notés oui et pas simplement la nouvelle ligne.

Je n'ai pas ce résultat. Faites vos test sur le fichier que vous avez placé sur le forum sans quoi on ne peut pas vérifier correctement

NB : mon explication sur la variable lig était pour le code précédent. Là vous n'avez plus cette variable dans le dernier code

Rem : Attention que dans votre fichier posté vous avez placé le code Transfert dans Thisworkbook. Bien évidemment il ne doit pas être placé là bas mais bien dans un module et est à supprimer de cet endroit

L'erreur est sur cette ligne :

Rem : Attention que dans votre fichier posté vous avez placé le code Transfert dans Thisworkbook. Bien évidemment il ne doit pas être placé là bas mais bien dans un module et est à supprimer de cet endroit

Ok, j'ai mis la macro dans un module

Je n'ai pas ce résultat. Faites vos test sur le fichier que vous avez placé sur le forum sans quoi on ne peut pas vérifier correctement

Lorsque je fais sur le fichier test ça a fonctionné 1 fois et ensuite j'ai l'erreur d'exécution 9

L'erreur est sur cette ligne :
Lorsque je fais sur le fichier test ça a fonctionné 1 fois et ensuite j'ai l'erreur d'exécution 9

Je n'ai aucune erreur de mon coté.

Vérifiez :
- la valeur de i pour savoir dans quelle feuille vous êtes au moment de l'erreur (pour le savoir --> une fois la ligne en jaune, passez votre souris sur le i de Sheets(i)

Je dois savoir où (feuille et ligne) vous ajoutez une info quand vous avez cette erreur