Microsoft 365 Report de ligne d'un onglet vers d'autres onglet en fonction du mot dans une cellule.

ddavid237 · 26 Juin 2022

Bonjour,

J'ai un souci pour un fichier d'indexation.
j'aimerais que les lignes du 1er onglet "indexation" se dispatchent dans les onglets correspondant à la colonne "C", mais que ces lignes restent aussi dans ce 1er onglet.
Il faudrait donc aussi un marqueur dans la colonne "I" pour que les lignes ne se copient qu'une seule fois.
pour info; La colonne G étant un repère de nouveauté (la case restant en jaune pendant un mois en relation avec la colonne "A")

J'espère être assez clair dans mes explications.

Fichier joint

En vous remerciant par avance de votre aide

Daniel

Robert · 26 Juin 2022

Bonsoir le fil, bonsoir le forum,

En pièce jointe toin fichier modifié avec le code ci-dessous :

VB:

Sub Macro2()
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim I As Integer 'déclare la variable I (Incrément)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set OS = Worksheets("indexation") 'définit l'onglet source OS
DL = OS.Cells(Application.Rows.Count, "A").End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne A de l'onglet...

sylvanu · 26 Juin 2022

Bonsoir Ddavid,
Vous n'étiez pas très loin !
Je n'ai pas compris l'utilité de votre test sur Err, vous pourriez expliquer ?
En Pj ça à l'air de marcher.

VB:

Sub Repartis()
    On Error Resume Next
    Application.ScreenUpdating = False
    DL = [C65000].End(3).Row
    For lig = 3 To DL
        If Cells(lig, "I") = "" Then                ' si vide on transfrt
            With Sheets(Cells(lig, 3).Text)
                bas = .[C65000].End(3).Row + 1
                Range("A" & lig & ":H" & lig).Copy
                .Cells(bas, 1).PasteSpecial
                Cells(lig, "I") = "Fait"            ' on tague la ligne
                .Columns.AutoFit                    ' on ajuste la largeur des colonnes
                .[A1].Select                        ' juste pour l'esthétique
            End With
        End If
    Next
    Application.ScreenUpdating = True
End Sub

Robert · 26 Juin 2022

Bonsoir le fil, bonsoir le forum,

En pièce jointe toin fichier modifié avec le code ci-dessous :

VB:

Sub Macro2()
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim I As Integer 'déclare la variable I (Incrément)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set OS = Worksheets("indexation") 'définit l'onglet source OS
DL = OS.Cells(Application.Rows.Count, "A").End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne A de l'onglet OS
TV = OS.Range("A1:I" & DL) 'définit le tabvleau des valeurs TV
For I = 3 To DL 'boucle sur toutes les lignes I du tableau des valeurs TV (en partqant de la troisième)
    If Not UCase(TV(I, 9)) = "X" Then 'condition : si la donnée ligne I colonne 9 (=> colonne I) ne vaut ni "X" ni "x"
        Set OD = Worksheets(TV(I, 3)) 'définit l'onglet destination OD
        'définit la cellule de destination DEST (première cellule vide de la colonne A de l'onglet OD)
        Set DEST = OD.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0)
        OS.Cells(I, 1).Resize(1, 8).Copy DEST 'copie les 8 cellules de la ligne de la boucle l'onglet source et les colle dans DEST
        OS.Cells(I, "I").Value = "X" 'écrit X dans la cellule ligne I colonne "I"
    End If 'fin de la condition
Next I 'prochaine  ligne de la boucle
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
End Sub

Il y a encore des erreurs DUCUMENTS ET FORMULAIRES au lieu de DOCUMENTS ET FORMULAIRES. Corrigées dans le fichier joint dans les onglets indexation et Données...
Clique sur le bouton Dispatch en haut à gauche de l'onglet indexation...
Le fichier :

ddavid237 · 28 Juin 2022

Robert à dit:

Bonsoir le fil, bonsoir le forum,

En pièce jointe toin fichier modifié avec le code ci-dessous :

VB:

Sub Macro2()
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim I As Integer 'déclare la variable I (Incrément)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set OS = Worksheets("indexation") 'définit l'onglet source OS
DL = OS.Cells(Application.Rows.Count, "A").End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne A de l'onglet OS
TV = OS.Range("A1:I" & DL) 'définit le tabvleau des valeurs TV
For I = 3 To DL 'boucle sur toutes les lignes I du tableau des valeurs TV (en partqant de la troisième)
    If Not UCase(TV(I, 9)) = "X" Then 'condition : si la donnée ligne I colonne 9 (=> colonne I) ne vaut ni "X" ni "x"
        Set OD = Worksheets(TV(I, 3)) 'définit l'onglet destination OD
        'définit la cellule de destination DEST (première cellule vide de la colonne A de l'onglet OD)
        Set DEST = OD.Cells(Application.Rows.Count, "A").End(xlUp).Offset(1, 0)
        OS.Cells(I, 1).Resize(1, 8).Copy DEST 'copie les 8 cellules de la ligne de la boucle l'onglet source et les colle dans DEST
        OS.Cells(I, "I").Value = "X" 'écrit X dans la cellule ligne I colonne "I"
    End If 'fin de la condition
Next I 'prochaine  ligne de la boucle
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
End Sub

Il y a encore des erreurs DUCUMENTS ET FORMULAIRES au lieu de DOCUMENTS ET FORMULAIRES. Corrigées dans le fichier joint dans les onglets indexation et Données...
Clique sur le bouton Dispatch en haut à gauche de l'onglet indexation...
Le fichier :

Bonjour Robert,

Ca marche nickel, je suis vraiment content de la solution qui va m'économiser un temps précieux.

Encore tout mes remerciements pour cette solution.

Cordialement

Daniel

Deadpool_CC · 28 Juin 2022

Bonsoir,

Il est coutume de "marquer comme solution" le post de la personne qui t'as trouvé la solution ... et je ne crois pas que cela soit toi

ddavid237 · 28 Juin 2022

Deadpool_CC à dit:
Bonsoir,

Il est coutume de "marquer comme solution" le post de la personne qui t'as trouvé la solution ... et je ne crois pas que cela soit toi

Bonsoir,

Désolé, je voulais juste mettre que le problème était résolu !
Jai corrigé !
Merci
Bonne soirée !

soan · 28 Juin 2022

Bonsoir Daniel, le fil,

ddavid237 à dit:
Désolé, je voulais juste mettre que le problème était résolu !
J'ai corrigé !

pas exactement !

quand c'est réussi, le post marqué comme solution a un bord vertical droit sur fond vert, et ce n'est pas le cas ! tu dois faire comme indiqué sur cette image :

soan

Microsoft 365 Report de ligne d'un onglet vers d'autres onglet en fonction du mot dans une cellule.

ddavid237

XLDnaute Nouveau

Pièces jointes

Robert

sylvanu

XLDnaute Barbatruc

Pièces jointes

Robert

XLDnaute Barbatruc

Pièces jointes

ddavid237

XLDnaute Nouveau

Deadpool_CC

XLDnaute Accro

ddavid237

XLDnaute Nouveau

soan

XLDnaute Barbatruc

Discussions similaires