Ecriture sur deux feuilles en fonction d'une condition

Question

Il me faudrait un peu d'aide concernant une formule VBA, je m'explique : j'ai une "LISTE" qui regroupe des données pour toutes les régions ( au total 6 régions ex; REG_01 etc..) je souhaiterai que, lorsque j'écris une ligne dans cette "LISTE", en fonction de ce qu'il y a noté dans la case "région" (mes 6 régions 01,02,03,04,05,06), cette ligne soit retranscrite à l'identique dans la feuille correspondante à la région j'espère avoir été claire dans mon explication, je n'arrive pas a faire ma formule en VBA pour effectuer cette commande... je vous joint mon classeur merci d'avance pour votre aide et bonne journée à tous https://www.cjoint.com/c/EHFiZr2e2Tf...

DjiDji59430 · Answer

Un essais , avec une formule (matricielle)...

ThauThème · Answer

Le seul problème c'est quand lancer la macro ? • Lors de l'édition de la colonne I (colonne des régions) et dans ce cas les colonnes suivantes (J à Q) se seront pas renseignées dans l'onglet de la région • Au double-clic dans une cellule de la ligne pour la copier dans l'onglet de sa région ? Je pense que la seconde option est plus logique. Essaie le code ci-dessous à placer dans l'onglet LISTE Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 'au double-clic dans l'onglet Dim LI As Integer 'déclare la variable LI (LIgne) Dim O As Worksheet 'déclare la variable O (Onglet) Dim DEST As Range 'déclare la variable DEST (cellule de DESTination) 'condition 1 : si le double-clic a lieu a partir de la troisième ligne dans une des cellules de la plage utilisée If Target.Row &gt; 2 And Not Application.Intersect(UsedRange, Target) Is Nothing Then Cancel = True 'annule le mode &#91;Édition&#93; lié au double-clic LI = Target.Row 'définit la ligne LI On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante) Set O = Sheets("REG_" &amp; Cells(Target.Row, 9).Value) 'définit l'onglet O (génère une erreur si c'est onglet n'existe pas) If Err &lt;&gt; 0 Then 'condition 2 : si une erreur a été générée Err.Clear 'supprime l'erreur MsgBox "L'onglet " &amp; Chr(34) &amp; "REG_" &amp; Cells(Target.Row, 9).Value &amp; Chr(34) &amp; " n'existe pas !" 'message Exit Sub 'sort de la procédure End If 'fin de la condition 2 Set DEST = O.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0) 'définit la cellue de destination DEST Rows(LI).Copy DEST 'copie la ligne LI et la colle dans DEST Cells(LI, 1).Resize(1, 17).Interior.ColorIndex = 3 'colore la ligne de rouge (pour indiquer qu'elle a déjà été transférée) End If 'fin de la condition End Sub...

ThauThème · Answer

Re, • Place le code dans l'onglet LISTE • double-clique dans une ligne éditée et regarde dans l'onglet correspondant a sa région.......

patrick1957 · Answer

Ca semble pourtant simple, tu tapes tes informations dans une nouvelle ligne, et ensuite un double clic les copie dans l'onglet qui correspond à la région de la colonne "I" P...

ThauThème · Answer

Re,

Arf Patrick ! Merci pour le soutien... C'est vrai que j'aurais pu commenter les code !...

Quoi ?! Je l'ai fait... Pff !... pourquoi il se décarcasse le père Ducros (pub quand tu nous tient...) ?

Re,

Assigner le code a un bouton oui si tu veux effectuer le code sur plusieurs lignes, sinon, au cas par cas, le double-clic est plus logique à moins que tu ne fasses suivre le bouton...

patrick1957 · Answer

Quel intéret puisque le double clic te fait la copie ET te le signale par du rouge ...

ThauThème · Answer

Re,

Le code pour un bouton :

Sub Macro1()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim I As Integer 'déclare la variable I (Incrément)
Dim DEST As Range 'déclare la variable DEST (cellule de DESTination)

DL = Sheets("LISTE").Cells(Application.Rows.cout, 1).End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne 1 (=A)
If DL < 3 Then Exit Sub 'si DL est inférieur à 3, sort de la procédure
For I = 3 To DL 'boucle de la ligne 3 à DL
    If Cells(I, 1).Interior.ColorIndex = 3 Then GoTo suite 'si la cellule ligne I colonne 1 (=A) est colorée de rouge, va à l'étiquette suite
    On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
    Set O = Sheets("REG_" & Cells(I, 9).Value) 'définit l'onglet O (génère une erreur si c'est onglet n'existe pas)
    If Err <> 0 Then 'condition 2 : si une erreur a été générée
        Err.Clear 'supprime l'erreur
        MsgBox "L'onglet " & Chr(34) & "REG_" & Cells(Target.Row, 9).Value & Chr(34) & " n'existe pas !" 'message
        GoTo suite 'va à l'étiquette "suite"
    End If 'fin de la condition 2
    Set DEST = O.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0) 'définit la cellue de destination DEST
    Rows(I).Copy DEST 'copie la ligne LI et la colle dans DEST
    Cells(I, 1).Resize(1, 17).Interior.ColorIndex = 3 'colore la ligne de rouge (pour indiquer qu'elle a déjà été transférée)
suite: 'étiquette
Next I 'prochaine lige de la boucle
End Sub

Ne pas supprimer la couleur rouge car elle permet de repérer les lignes déjà transférées...

ThauThème · Answer

Re, Désolé c'est de ma faute je n'ai pas testé et il il a une erreur. Remplace Rows. cout par Rows. Count .....

ThauThème · Answer

Re, Pour ma part, je suis incompétent dans ce domaine mais je pense qu'il serait préférable de créer un nouveau sujet....