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

XLDnaute Nouveau
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 😅
 

Pièces jointes

  • Tableau Inventaire produits chimiques A1 V2 XL Download.xlsm
    430.7 KB · Affichages: 18
Solution
Bonjour llaee, Phil69970,

D'après ce que j'ai compris, voyez le fichier joint et cette macro dans ThisWorkbook :
VB:
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...

Phil69970

XLDnaute Barbatruc
Bonjour @llaee

Je te propose ce fichier

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


2)
Quand tu cliques sur :
1647943404029.png

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
 

Pièces jointes

  • Tableau Inventaire produits chimiques A1 V3 22 Mars 2022.xlsm
    356.3 KB · Affichages: 8

llaee

XLDnaute Nouveau
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 ! 🤩
 

Pièces jointes

  • 1647945081112.png
    1647945081112.png
    4.5 KB · Affichages: 14
  • 1647945108135.png
    1647945108135.png
    63.2 KB · Affichages: 15

Phil69970

XLDnaute Barbatruc
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

XLDnaute Barbatruc
Bonjour llaee, Phil69970,

D'après ce que j'ai compris, voyez le fichier joint et cette macro dans ThisWorkbook :
VB:
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+
 

Pièces jointes

  • Tableau Inventaire produits chimiques A1(1).xlsm
    199.2 KB · Affichages: 28

job75

XLDnaute Barbatruc
Bonjour llaee,

Effectivement il faut supprimer tous les objets de la feuille avant le copier-coller, prenez ce fichier (2) :
VB:
    Application.ScreenUpdating = False
    Sh.DrawingObjects.Delete 'supprime les objets
A+
 

Pièces jointes

  • Tableau Inventaire produits chimiques A1(2).xlsm
    208.2 KB · Affichages: 4

Statistiques des forums

Discussions
299 832
Messages
1 979 388
Membres
206 710
dernier inscrit
Melkia