Macro Copier Avec Plusieurs Conditions

Bonjour à tous,

J'aurais besoin de votre aide afin de faire une petite macro, je vous remercie d'avance pour votre aide.

J'aimerais que cette macro ne ce d’éclanche pas en la lancent mais soit continue.

Je vous explique la macro :

Dans le fichier joint vous trouverez une feuille du nom de "SUPPLEMENT", sur cette feuille je fait des choix.

Dans la colonne "A" - "LOT", je choisis un lot qui correspond au nom d'une autre feuille.

Dans la colonne "B" - "DESIGNATION", j’écris un texte.

Dans la colonne "C" - "COMPRIS ou NON-COMPRIS", Je choisis Compris ou Non.

Ce que je souhaiterais faire, est la chose suivante, après avoir effectué mes choix sur la feuille "SUPPLEMENT", je souhaiterais que mon texte de la colonne "B" et la sélection de la colonne "C" soit copié automatiquement sur les feuilles comportant le nom de la Colonne "A".

Je ne suis pas un champion des macros et la ça deviens franchement compliqué.

Merci d'avance,

Cordialement,

Laurent

Bonjour Laurents, bonjour le forum,

Peut-être avec la macro événementielle Change ci-dessous, à placer dans l'onglet SUPPLEMENT :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim OD As Worksheet 'déclare la variable OD (Onglet de DEstination)
Dim CD As Range 'déclare la variable CD (Cellule de DEstination)
Dim DEC As Byte 'déclare la variable DEC (DÉCalage)

If Target.Column = 3 Then 'condition 1 : si le changement a lieu dans la colonne 3 (=C)
    'condition 2 : si aucune cellule vide dans la ligne du changement en colonne A, B et C
    If Application.WorksheetFunction.CountBlank(Range(Cells(Target.Row, 1), Cells(Target.Row, 3))) = 0 Then
        Set OD = Sheets(Cells(Target.Row, 1).Value & " - SUPPLEMENT") 'définit l'onglet de destination OD
        Set CD = OD.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0) 'définit la cellule de destination CD
        CD.Value = Cells(Target.Row, 2) 'renvoie le [Choix dessuppléments] dans la cellule de destination CD
        DEC = IIf(Target.Value = "Compris dans le prix", 1, 2) 'définit le décalage DEC
        CD.Offset(0, DEC).Value = "X" 'renvoie "X" dans CD décalé de DEC cellules à droite
    End If 'fin de la condition 2
End If 'fin de la condition 1
End Sub

Merci beaucoup, ça fonctionne très bien.

Par contre quand je vide le tableau de la feuille "SUPPLEMENT", les choix reste dans les autres feuilles.

Peux-ton faire en sorte que si j’efface le contenu du tableau, le contenu des autres feuilles s'effaces ?

Merci d'avance,

Cordialement,

Laurent

Re,

C'est beaucoup plus complexe et si tu l'avais dit avant je ne m'y serais pas risqué. En plus, je ne vois pas l'intérêt alors de créer tous ces onglets...

Ce n'est pas grave je comprend, je vais partir sur votre solution.

Merci beaucoup pour le coup de mains.

Bonjour,

Je reviens vers vous afin de bénéficier de votre aide.

• Je souhaiterais rajouter au code suivant une colonne supplémentaire "MONTANT" colonne D (voir Tableau ci-joint), ainsi qu'une colonne "TYPE DE PROVISION" colonne "E"?
• Concernant les Feuilles "SUPPLEMENT" si je rajout un texte manuellement sur la dernière ligne (voir Tableau "TEXT MANUEL" dernière ligne des feuilles "SUPPLEMENT") l'incrémentation des valeurs ce fait à la suite et non en haut.

-Par ailleurs pouvez-vous m'aider également à créer une macro que je relierais à un bouton pour effacer les textes rajoutés sur les feuilles "SUPPLEMENT" ?

Un grand Merci d'avance,

Cordialement,

Laurent

ThauThème a écrit :

Bonjour Laurents, bonjour le forum,

Peut-être avec la macro événementielle Change ci-dessous, à placer dans l'onglet SUPPLEMENT :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim OD As Worksheet 'déclare la variable OD (Onglet de DEstination)
Dim CD As Range 'déclare la variable CD (Cellule de DEstination)
Dim DEC As Byte 'déclare la variable DEC (DÉCalage)

If Target.Column = 3 Then 'condition 1 : si le changement a lieu dans la colonne 3 (=C)
    'condition 2 : si aucune cellule vide dans la ligne du changement en colonne A, B et C
    If Application.WorksheetFunction.CountBlank(Range(Cells(Target.Row, 1), Cells(Target.Row, 3))) = 0 Then
        Set OD = Sheets(Cells(Target.Row, 1).Value & " - SUPPLEMENT") 'définit l'onglet de destination OD
        Set CD = OD.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0) 'définit la cellule de destination CD
        CD.Value = Cells(Target.Row, 2) 'renvoie le [Choix dessuppléments] dans la cellule de destination CD
        DEC = IIf(Target.Value = "Compris dans le prix", 1, 2) 'définit le décalage DEC
        CD.Offset(0, DEC).Value = "X" 'renvoie "X" dans CD décalé de DEC cellules à droite
    End If 'fin de la condition 2
End If 'fin de la condition 1
End Sub

Re -bonjour

Est-ce qu'une âme charitable pourrait me venir en aide?

Merci d'avance,

Cordialement,

Laurent