Copier automatiquement des valeurs vers une autre feuille

**Rabiry** · 18/01/2013, 13h15

Bonjour,

Voila j'ai une feuille appellé "facture" qui a les renseignements suivant :

N° de la facture, Réference du dossier, nom de la société facturé, nom des clients prise en Charge, le montant total et date de la facture.

Dans une autre feuille appellé CA, je voudrais bien dans un tableau, collecter certain données telle que :
Nom de la société, nom du clients, date de la facture et montant

Comment puis je les copier automatiquement si a chaque fois que je change de référence, ces données seront copier à la première ligne vide de la feuille CA

Merci beaucoup

**Daniel.C** · 18/01/2013, 14h20

Bonjour,

Est-ce que tu peux avoir plusieurs noms de client ? Si oui, il faudra un bouton pour copier les données; sinon, on peut s'en passer.

**Rabiry** · 18/01/2013, 16h16

Oui mais je voudrais bien l'automatiser avec Worksheet_Change mais l'essais que j'ai fait n'a pas marché.

ce que je souhaite faire c'est quand je change de reference clients, les infos correspondant au référence précédant se copie automatiquement dans la feuille CA

Merci et a+

**Daniel.C** · 18/01/2013, 16h45

Oui, mais comme tu peux avoir plusieurs noms de clients pour la même référence, on ne sait pas quand déclencher la copie. Ou j'ai mal compris ?

**Rabiry** · 19/01/2013, 14h57

Excusez moi! c'est moi qui a mal compris.

Une référence correspond à un clients donc la copie se fera à chaque fois que je change de client.

Merci beaucoup

**Daniel.C** · 19/01/2013, 18h06

Voici le code qui fonctionne avec le classeur joint.. J'ai nommé les cellules de la feuille "Facture" (leur nom se trouve en ligne 3) les cellules à remplir se trouvent en ligne 2. Les cellules se copient si la référence dossier n'existe pas sur la feuille "CA".

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Ligne As Long, Plage As Range, C As Range
If Intersect(Target, Union([Facture], [RéfDossier], [Société], [Client], [Montant], _
    [DateFacture])) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
If Application.CountA(Union([Facture], [RéfDossier], [Société], [Client], [Montant], _
    [DateFacture])) < 6 Then Exit Sub
If Not IsNumeric(Application.Match([RéfDossier].Value, [CA!B:B], 0)) Then
    With Sheets("CA")
        Ligne = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
        Set Plage = Union([Facture], [RéfDossier], [Société], [Client], [Montant], _
            [DateFacture])
        For i = 1 To Plage.Count
            .Cells(Ligne, i) = Plage(i)
        Next
    End With
End If
End Sub

**Rabiry** · 21/01/2013, 09h29

Bonjour!

Je vous remercie beaucoup pour le travail parce que le code fonctionne bien. Toutefois, j'ai du mal à l'adapter avec mon fichier que vous trouverez attaché avec ce message. Aussi, j'ai du mal à inclure mon code pour automatiser le numéro de facture (code en vert). Je ne sais pas si vous pouvez m'aider à l'affiner car je suis un débutant en VB.

Encore merci pour votre aide

Bruno

**Daniel.C** · 21/01/2013, 10h51

Bonjour,

Je n'arrive pas à localiser le tour opérateur (le nom "TO" fait référence à "Facture!#REF!")
La feuille "CA" montre plusieurs lignes avec le même numéro de facture. Est-ce qu'il faut faire une ligne dans CA par ligne de la facture ?

**Rabiry** · 21/01/2013, 12h37

Ci-joint le fichier rectifié. En fait les numéro de factures sont les seul qui fonctionnent quand j'ai fait l'essai. Une ligne correspond à une facture, un client , ...

Merci beaucoup

**Daniel.C** · 21/01/2013, 13h31

J'ai modifié le code comme suit (regarde le fichier en PJ) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Ligne As Long, Plage As Range, C As Range
If Intersect(Target, Union([Facture], [RéfDossier], [To], [Client], [Montant], _
    [DateFacture])) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub
If Application.CountA(Union([Facture], [RéfDossier], [To], [Client], [Montant], _
    [DateFacture])) < 6 Then Exit Sub
    Set Plage = Union([Facture], [RéfDossier], [To], [Client], [Montant], _
        [DateFacture])
If Not IsNumeric(Application.Match([Facture].Value, [CA!A:A], 0)) Then
    With Sheets("CA")
        Ligne = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
        For i = 1 To Plage.Count
            .Cells(Ligne, i) = Plage.Areas(i)
        Next
    End With
End If
End Sub

**Rabiry** · 21/01/2013, 14h34

Il fonctionne très bien merci beaucoup une dernière soucis que je n'arrive pas à gérer c'est l'incrémentation automatique du N° de Facture qui est en relation avec la valeur de P1. Comment puis je l'insérer sachant que le code que j'ai utilisé pour ce faire est en vert.

Merci beaucoup

Bruno

**Daniel.C** · 21/01/2013, 15h39

J'ai un peu de mal à comprendre. La macro incrémente Q1 alors que le numéro de facture prend la valeur de P1. Qu'est-ce que je dois faire ?

**Rabiry** · 22/01/2013, 09h15

Bonjour,

En fait, ça c'est une erreur due au faite que j'ai supprimé des collones pour alèger le fichier afin de l'evoyer. Normalement pour ce fichier le macro doit incrémenter p1 mais non pas q1.

Salutations

**Daniel.C** · 22/01/2013, 10h58

Bonjour,

En utilisant P1, mets cette macro dans la feuille "Facture" :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
Const celref = "n17"
Const celnum = "P1"
 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Ligne As Long, Plage As Range, C As Range
    If Not Intersect(Target, Range(celref)) Is Nothing Then
      Application.EnableEvents = False
      Range(celnum).Value = Range(celnum).Value + 1
      Application.EnableEvents = True
    ElseIf Intersect(Target, Union([Facture], [RéfDossier], [To], [Client], [Montant], _
        [DateFacture])) Is Nothing Then Exit Sub
        If Target.Count > 1 Then Exit Sub
        If Application.CountA(Union([Facture], [RéfDossier], [To], [Client], [Montant], _
            [DateFacture])) < 6 Then Exit Sub
            Set Plage = Union([Facture], [RéfDossier], [To], [Client], [Montant], _
                [DateFacture])
        If Not IsNumeric(Application.Match([Facture].Value, [CA!A:A], 0)) Then
            With Sheets("CA")
                Ligne = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
                For i = 1 To Plage.Count
                    .Cells(Ligne, i) = Plage.Areas(i)
                Next
            End With
        End If
    End If
End Sub

**Rabiry** · 23/01/2013, 08h27

Bonjour,

Après avoir copier le dernier code, j'ai constaté :
1°) P1 s'incrémente automatiquement
2°) la copie de n'effectue pas

en cherchant source du problème, j'ai comparé les deux codes la 1er sans incrémentation mais la copie marche et la deuxième ; j'ai trouvé que cette ligne de code (sur la dernière code que vous avez suggéré) empêche la copie.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
ElseIf Intersect(Target, Union([Facture], [RéfDossier], [To], [Client], [Montant], _
      [DateFacture])) Is Nothing Then Exit Sub

Tout en essayant de comprendre les codes, je voudrais savoir si c'est vraiment ca qui fait bloquer la copie car quand j'ai mis un apostrophe devant la copie s'est éfféctué

Salutations

Bruno

**Daniel.C** · 23/01/2013, 12h30

Bien vu !

Il faut modifier le code comme suit :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Ligne As Long, Plage As Range, C As Range
    If Not Intersect(Target, Range(celref)) Is Nothing Then
      Application.EnableEvents = False
      Range(celnum).Value = Range(celnum).Value + 1
      Application.EnableEvents = True
    ElseIf Not Intersect(Target, Union([Facture], [RéfDossier], [To], [Client], [Montant], _
        [DateFacture])) Is Nothing Then
        If Target.Count > 1 Then Exit Sub
        If Application.CountA(Union([Facture], [RéfDossier], [To], [Client], [Montant], _
            [DateFacture])) < 6 Then Exit Sub
            Set Plage = Union([Facture], [RéfDossier], [To], [Client], [Montant], _
                [DateFacture])
        If Not IsNumeric(Application.Match([Facture].Value, [CA!A:A], 0)) Then
            With Sheets("CA")
                Ligne = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
                For i = 1 To Plage.Count
                    .Cells(Ligne, i) = Plage.Areas(i)
                Next
            End With
        End If
    End If
End Sub

**Rabiry** · 23/01/2013, 15h10

Je n'arrive pas à comprendre pourquoi le code proposé ci-dessus n'effectue pas la copie alors que ceci effectue la copie

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Ligne As Long, Plage As Range, C As Range
    If Not Intersect(Target, Range(celref)) Is Nothing Then
      Application.EnableEvents = False
      Range(celnum).Value = Range(celnum).Value + 1
      Application.EnableEvents = True
        If Target.Count > 1 Then Exit Sub
        If Application.CountA(Union([Facture], [RéfDossier], [To], [Client], [Montant], _
            [DateFacture])) < 6 Then Exit Sub
            Set Plage = Union([Facture], [RéfDossier], [To], [Client], [Montant], _
                [DateFacture])
        If Not IsNumeric(Application.Match([Facture].Value, [CA!A:A], 0)) Then
            With Sheets("CA")
                Ligne = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
                For i = 1 To Plage.Count
                    .Cells(Ligne, i) = Plage.Areas(i)
                Next
            End With
        End If
    End If
End Sub

Avec ce code mon problème est résolu mais je cherche seulement à comprendre pourquoi?

En tout cas, Grand merci pour votre aide

Bruno

**Daniel.C** · 23/01/2013, 16h59

Désolé, ENORME erreur de logique !

Oui, le code que tu publies fonctionne, mais il risque de déclencher la macro intempestivement (à chaque fois que tu remplis la facture). Il n'y aurait rien de copié parce qu'il y a d'autres sécurités, mais c'est inutile.

Remplace par ce code (testé, cette fois-ci) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Ligne As Long, Plage As Range, C As Range
    If Not Intersect(Target, Range(celref)) Is Nothing Then
      Application.EnableEvents = False
      Range(celnum).Value = Range(celnum).Value + 1
      Application.EnableEvents = True
    End If
    If Not Intersect(Target, Union([Facture], [RéfDossier], [To], [Client], [Montant], _
        [DateFacture])) Is Nothing Then
        If Target.Count > 1 Then Exit Sub
        If Application.CountA(Union([Facture], [RéfDossier], [To], [Client], [Montant], _
            [DateFacture])) < 6 Then Exit Sub
            Set Plage = Union([Facture], [RéfDossier], [To], [Client], [Montant], _
                [DateFacture])
        If Not IsNumeric(Application.Match([Facture].Value, [CA!A:A], 0)) Then
            With Sheets("CA")
                Ligne = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
                For i = 1 To Plage.Count
                    .Cells(Ligne, i) = Plage.Areas(i)
                Next
            End With
        End If
    End If
End Sub

**Rabiry** · 24/01/2013, 08h31

SUPER!

Ceci fonctionne très bien. Je vous remercie beaucoup pour votre aide.

A bientôt pour un autre problème

Bruno

Copier automatiquement des valeurs vers une autre feuille [XL-2003]

Macros et VBA Excel

Discussions similaires

Partager

Partager