Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

L

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: 20
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...
Trier par date Trier par votes

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


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
 

Pièces jointes

  • Tableau Inventaire produits chimiques A1 V3 22 Mars 2022.xlsm
    356.3 KB · Affichages: 10
Vote positif 0 Vote négatif
L

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
    4.5 KB · Affichages: 37
  • 1647945108135.png
    63.2 KB · Affichages: 39
Vote positif 0 Vote négatif

Phil69970

XLDnaute Barbatruc
Re

llaee à dit:
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 ?
Cliquez pour agrandir...
Oui voir § 4)
Phil69970 à dit:
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
Cliquez pour agrandir...

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
 
Vote positif 0 Vote négatif

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: 30
Vote positif 1 Vote négatif
Solution

job75

XLDnaute Barbatruc
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+
 
Vote positif 0 Vote négatif

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
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

L
  • Résolu(e)
Microsoft 365 Copie d'une ligne entière sur une autre feuille à partir d'une colonne oui/non
Réponses
9
Affichages
1 K
Phil69970
E
  • Question
copie automatique de lignes de différents onglets vers un autre onglet général
Réponses
7
Affichages
9 K
CHALET53
C
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…