Copie de lignes suivant conditions

bonjours a tous,

voila je suis un peu embêter sur des copies de ligne, car je maitrise trop peu VBA.

j'explique:

pour chaque lignes d'activités j'attribue un mois de validation par rapport a la facture établie par le client.

j'aimerai que dés que je remplie cette colonne, via un bouton la ligne se copie dans la feuille du mois correspondant.

de plus j'aimerai que sa se fasse pour toute les feuilles si possible.

je remercie par avance tous ceux qui voudront et/ou essaieront de m'aider

Salut MJ33,

bienvenue parmi nous!

Si je résume bien, tu veux pouvoir copier dans la feuille dont le nom correspond au mois de validation (en S) toute la ligne concernée, de A à S? Et ce, j'imagine, sur la première ligne libre, évidemment tout en l'effaçant de la feuille d'origine?

La couleur de la cellule S doit rester identique (jaune) ou passer au rouge dans sa feuille de destination?

Attention à l'orthographe en colonne S, tant qu'à faire : fevrie

, ça peut aider!

Pourquoi un bouton? Si vraiment, où le veux-tu?

A te lire,

A+

merci pour l'intérêt que tu porte a mon problème

oui c'est a peu près sa mise a par que je ne veut pas que sa l'efface sur la feuille d'origine sa me permet d'avoir une archive.

et en se qui concerne la couleur c'est de la MFC donc se sont les valeurs des cellules qui m'importe plus

pour "FEVRIE" je m'en suis aperçu après avoir mis le fichier en pièces jointe, je m'en excuse

pour le bouton je sais pas si c'est vraiment utile, si la macro s'effectue automatiquement.

encore merci pour le temps consacrer

A+

Salut MJ,

voici ton fichier.

Seule la feuille Janvier est "équipée" et fonctionnera.

Si tu es satisfait, tu recopies la procédure :

- Private Sub Worksheet_Change(ByVal Target As Range)

dans toutes les feuilles concernées par cette action.

Bon travail!

A+

je te remercies sa fonctionne parfaitement

je me lance sur les autres feuilles en espérant aucun petit soucis

encore merci

a+

bonsoir et désoler de rouvrir se sujet après temps de temps

mais je me suis aperçu d'un soucis.

j'explique:

quand j'ai mis janvier sur la feuille de janvier sa ma ajouter la ligne ""normal" c'est se que j'avais demander

le truc c'est que je veut pas que pour le mois de validation correspondant a la même feuille sa me le copie sa me sert a rien d'avoir un doublon.

encore désoler de ma lenteur

merci a qui viendra m'aider

Salut Mj,

que je suis bête! Pas pensé à cette évidence!

Private Sub Worksheet_Change(ByVal Target As Range)
'
If Not Application.Intersect(Target, Range("S7:S48")) Is Nothing Then
    sFlag = Target.Value
   [color=#FF0000] If sFlag = ActiveSheet.Name Then Exit Sub[/color]
    iRow = Target.Row
    For x = 1 To Worksheets.Count
        If sFlag = Sheets(x).Name Then
            iDRow = Worksheets(x).Range("B" & Rows.Count).End(xlUp).Row + 1
            Range("A" & iRow & ":S" & iRow).Copy Destination:=Worksheets(x).Range("A" & iDRow & ":S" & iDRow)
            Exit For
        End If
    Next
End If
'
End Sub

Tu ajoutes la ligne en rouge qui teste la correspondance entre le mois de validation et le nom de la feuille active!

Désolé! Je suis parfois bien distrait!

A+

je te remercie pour cette petite correction et surtout c'est moi qui m'excuse de ne pas l'avoir préciser

bonne continuation

merci A+

salut encore un petit accro,

depuis que j'ai rajouter t'a ligne cela me mais erreur compilation je comprend pas pourquoi

VBA va me rendre fou

Salut MJ,

Ce sera plus facile, crois-moi!

A+

désole le voila.

Sacré MJ, va,

   <span style="color: #FF0000"> If sFlag = ActiveSheet.Name Then Exit Sub</span>

Parfois, l'éditeur d'Excel-Pratique zappe quelques commandes de surlignage. Ici, j'avais voulu souligner le code en rouge. Seul, le code HTML s'est incrusté mais ne fait pas partie de ce qui t'était destiné.

Le bon code est le suivant :

 If sFlag = ActiveSheet.Name Then Exit Sub

Devrait aller beaucoup mieux, évidemment!

A+

ok merci,

je sais je pige rien en VBA une erreur bégnine pour toi devient colossale pour moi

mais je le prend avec plaisir

je te remercie pour cette précision promis je t'embête plus

a bientôt

Salut pour mon instruction et dans un but de recréé une macro du même type est ce qu'on pourrai me traduit le code?

Private Sub Worksheet_Change(ByVal Target As Range)
'
If Not Application.Intersect(Target, Range("T7:T48")) Is Nothing Then
    sFlag = Target.Value
    If sFlag = ActiveSheet.Name Then Exit Sub
    iRow = Target.Row
    For x = 1 To Worksheets.Count
        If sFlag = Sheets(x).Name Then
            iDRow = Worksheets(x).Range("B" & Rows.Count).End(xlUp).Row + 1
            Range("A" & iRow & ":T" & iRow).Copy Destination:=Worksheets(x).Range("A" & iDRow & ":T" & iDRow)
            Exit For
        End If
    Next
End If
'
End Sub

Bonjour MJ,

Private Sub Worksheet_Change(ByVal Target As Range)
'
'si on clique dans les cellules entre T7 et T48
If Not Application.Intersect(Target, Range("T7:T48")) Is Nothing Then
    'on note la valeur
    sFlag = Target.Value
    'si cette valeur = nom de la feuille active, on ne fait rien
    If sFlag = ActiveSheet.Name Then Exit Sub
    'n° de ligne de la cellule cliquée
    iRow = Target.Row
    'boucle sur le nbre de feuilles
    For x = 1 To Worksheets.Count
        'si la valeur sauvée plus haut = nom de la feuille...
        If sFlag = Sheets(x).Name Then
            '...on calcule le n° de la première ligne libre de cette feuille...
            iDRow = Worksheets(x).Range("B" & Rows.Count).End(xlUp).Row + 1
            ...pour y coller la ligne de donnée qui se trouve dans iRow, sauvée plus haut
            Range("A" & iRow & ":T" & iRow).Copy Destination:=Worksheets(x).Range("A" & iDRow & ":T" & iDRow)
            'fini!
            Exit For
        End If
    Next
End If
'
End Sub

Bref, de la logique!

Bon travail et Joyeuses Fêtes!

A+

merci pour cette traduction

bonne fête

a+

je comprend pas comment modifié la conditions

la subtilité de la logique VBA me dépasse totalement

Salut MJ,

quelle condition?

Un peu courtes, tes explications...

a+

salut

pourquoi quand j'utiles ma macro cela me mes un message d'erreur:

Private Sub Worksheet_Change(ByVal Target As Range)
'
If Not Application.Intersect(Target, Range("T7:T48")) Is Nothing Then
    sFlag = Target.Value
   [color=#FFFF00] If sFlag = ActiveSheet.Name Then [/color]Exit Sub
    iRow = Target.Row
    For x = 1 To Worksheets.Count
        If sFlag = Sheets(x).Name Then
            iDRow = Worksheets(x).Range("B" & Rows.Count).End(xlUp).Row + 1
            Range("A" & iRow & ":T" & iRow).Copy Destination:=Worksheets(x).Range("A" & iDRow & ":T" & iDRow)
            Exit For
        End If
    Next
End If
'
End Sub

Bonjour MJ,

si tu as laissé ceci :

<span style="color: #FFFF00"> If sFlag = ActiveSheet.Name Then </span>Exit Sub

ça ne risque pas d'aller!

Plutôt ceci :

If sFlag = ActiveSheet.Name Then Exit Sub

Pour d'autres erreurs, envoie-moi ton fichier!

A+