Microsoft 365 Macro copie de lignes entières d'un onglet général vers onglets détaillés à partir d'une colonne oui/non

[llaee]

Bonjour à tous,

Cette demande en complète une précédente : https://www.excel-downloads.com/thr...uille-a-partir-dune-colonne-oui-non.20065270/

Sur un fichier d'inventaire de produits chimiques, j'aimerai pouvoir reporter les informations de l'onglet général recensant tous les produits utilisés par toutes les équipes dans des onglets reprenant les produits utilisés équipe par équipe.

Les demandes :
1. Copier coller le bandeau de l'onglet général (source unique d'alimentation des onglets détaillés) dans chacun des onglets pour que toute modification soit prise en compte lors d'activation de la macro
2. Conserver hauteur et largeur des cellules de l'onglet général
3. Demande principale : lorsque l'équipe est utilisatrice du produit, un "oui" apparaîtra dans la colonne de l'équipe concernée => exemple, pour le SPADO NETTOYANT DÉTARTRANT VINAIGRE BLANC utilisé par l'équipe CONFORT cellule D4 = oui ; alors copier l'intégralité de la ligne du fichier dans l'onglet "Confort" (avec conservation de la mise en forme source). Et ce pour chacune des 10 équipes dans les 10 onglets détaillés grâce à une macro "automatisée". A l'activation de la macro, cela "réinitialise" les données -> si une équipe passe de "oui" en "non", que cela supprime la ligne de l'onglet et inversement.

Suite à la demande précédente @Phil69970 a automatisé cette demande pour l'équipe Confort. L'idée serait de le déployer pour les 10. Un copié/collé en changeant les données ne fonctionne pas et ce sont mes seules "compétences" VBA

 

[Phil69970]

Bonjour @llaee

Je te propose ce fichier

Remarques :
1)
J'ai mis "Oui" dans les cellules en vert pour faire mes tests

2)
Quand tu cliques sur :

La macro passe sur chaque feuille supprimes tout sauf les titres puis copie les lignes "oui" correspondant à chaque onglet.

3)
La hauteur/largeur des lignes est conservée

4)
Je suis parti du principe que tu as 10 équipes donc j'ai fait les 10 onglets avec les titres (La macro ne le fait pas) puis j'ai fait la macro qui copie les lignes


*Merci de ton retour

@Phil69970

 

[llaee]

Bonjour @Phil69970,

Quelle réactivité ! Merci de ton aide précieuse depuis le début sur ce sujet.

1. Si je fais une modif sur le bandeau source (onglet général), cela ne se modifie pas dans les autres onglets est-ce normal ?

2. Parfait merci

3. Top également merci

J'ai un petit soucis de bug si je met mes cellules en couleurs (comme tu l'as fait en vert). Je n'ai pas testé toutes les colonnes. Le changement de couleur de la police a l'air ok mais le remplissage de la cellule fait planter le fichier. Je te mets en capture le message d'erreur. D'ailleurs même en essayant de remettre un remplissage blanc sur les cellules que tu as mises en vert ça plante..
Idem même bug lorsque l'on rajoute du texte dans une nouvelle colonne, exemple AX = ça plante mais de manière "aléatoire". Un essai ça fonctionne et l'autre non

En tout cas hormis les bugs énoncés le fichier est tip top merci beaucoup encore !

 

[Phil69970]

Re

1. Si je fais une modif sur le bandeau source (onglet général), cela ne se modifie pas dans les autres onglets est-ce normal ?

Oui voir § 4)

4)
Je suis parti du principe que tu as 10 équipes donc j'ai fait les 10 onglets avec les titres (La macro ne le fait pas) puis j'ai fait la macro qui copie les lignes

Tu as fait des essais avec le fichier que j'ai mis au post #2 ?
J'ai lancé la macro 10 fois de suite sans réussir à planter le fichier idem avec ou sans couleur.

Explique quand le fichier plante ==> j'ai mis le mot "xx" dans la feuille Y et la cellule Z et je fais ci ou ça et cela plante .....
Et mets en ligne le fichier qui plante

@Phil69970

 

[job75]

Bonjour llaee, Phil69970,

D'après ce que j'ai compris, voyez le fichier joint et cette macro dans ThisWorkbook :

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim col As Variant
With Sheets("Général")
    col = Application.Match(Sh.Name & "*", .UsedRange.Rows(3), 0)
    If IsError(col) Then Exit Sub
    Application.ScreenUpdating = False
    .Cells.Copy Sh.[A1] 'copie les cellules
    .[A1].Copy Sh.[A1] 'allège la mémoire
End With
ActiveWindow.Zoom = 55 'facultatif,règle le zoom
With Sh.UsedRange
    If .Rows.Count < 4 Then Exit Sub 'sécurité
    With .Offset(3).Resize(.Rows.Count - 3)
        .Columns(col).EntireColumn.Insert 'insère une colonne auxiliaire
        .Columns(col) = "=1/(RC[1]=""Oui"")" 'critère
        .Columns(col) = .Columns(col).Value 'supprime les formules
        .EntireRow.Sort .Columns(col), xlAscending, Header:=xlNo 'tri pour regrouper et accélérer
        On Error Resume Next 'si aucune SpecialCell
        .Columns(col).SpecialCells(xlCellTypeConstants, 16).EntireRow.Delete 'supprime les valeurs d'erreur
        .Columns(col).EntireColumn.Delete 'supprime la colonne auxiliaire
    End With
End With
With Sh.UsedRange: End With 'actualise les barres de défilement
End Sub

Elle se déclenche automatiquement quand on active une feuille.

Nota : j'ai supprimé le slash "/" en cellule J3...

A+

 

[llaee]

Bonjour @Phil69970 et @job75,

Je vous remercie vivement pour votre aide.

Tout semble fonctionner correctement après des premiers tests !
Belle journée

 

[job75]

Bonsoir PascaleMT, bienvenue sur XLD,

Créez votre propre discussion et joignez le fichier sans données confidentielles.

Avec des explications claires sur ce que vous voulez faire.

A+

 

[PascaleMT]

Bonsoir!
Parfait!
Merci beaucoup

 

[llaee]

Bonjour @job75,

Je viens de me rendre compte que les images des pictos se superposaient à l'infini sur les onglets à chaque actualisation... que faire s'il te plaît ?

Merci à toi !

 

[job75]

Bonjour llaee,

Effectivement il faut supprimer tous les objets de la feuille avant le copier-coller, prenez ce fichier (2) :

    Application.ScreenUpdating = False
    Sh.DrawingObjects.Delete 'supprime les objets

A+